diff options
| author | Sean Whitton <spwhitton@spwhitton.name> | 2022-05-05 20:33:40 -0700 |
|---|---|---|
| committer | Sean Whitton <spwhitton@spwhitton.name> | 2022-05-05 20:33:40 -0700 |
| commit | 486b8785b91c4a0c170a85bc1d5bcf971f878db1 (patch) | |
| tree | 8fd50e95765661d4b81393edb2b045f907ea6bcf | |
| parent | a2b18d170a0cd9cccd0a92e773db237aa169c598 (diff) | |
| parent | 7e9d364b663613fd907f92de31e996463ef7d03c (diff) | |
| download | emacs-486b8785b91c4a0c170a85bc1d5bcf971f878db1.tar.gz | |
Merge remote-tracking branch 'origin/master' into athena/unstable
446 files changed, 18106 insertions, 10627 deletions
diff --git a/ChangeLog.3 b/ChangeLog.3 index 18b7b7c11aa..be1a9bfe26a 100644 --- a/ChangeLog.3 +++ b/ChangeLog.3 @@ -1,3 +1,916 @@ +2022-04-13 Tassilo Horn <tsdh@gnu.org> + + dired: implement feature from 7b50ed553f differently + + * lisp/dired.el (dired-buffers-for-dir): Restore to emacs-27 version. + (dired-buffers-for-dir-or-subdir): New function. + (dired-clean-up-after-deletion): Use dired-buffers-for-dir-or-subdir + instead dired-buffers-for-dir. + +2022-04-13 Eli Zaretskii <eliz@gnu.org> + + Fix regression in 'dired-buffers-for-dir' + + * lisp/dired.el (dired-buffers-for-dir): Fix inadvertently swapped + arguments. (Bug#54636) + +2022-04-13 Eli Zaretskii <eliz@gnu.org> + + * lisp/desktop.el (desktop-read): Clarify warning text. + +2022-04-13 Po Lu <luangruo@yahoo.com> + + * doc/emacs/anti.texi (Antinews): Unannounce removal of Motif. + +2022-04-13 Lars Ingebrigtsen <larsi@gnus.org> + + Fix eshell-explicit-command-char doc string typo + + * lisp/eshell/esh-ext.el (eshell-explicit-command-char): Fix typo + in doc string (bug#54567). + +2022-04-13 Eli Zaretskii <eliz@gnu.org> + + Clarify the description of "selected tags table" + + * doc/emacs/maintaining.texi (Select Tags Table): Clarify the + distinction between the "selected tags table" and the "current + list of tags tables". (Bug#54543) + +2022-04-13 Lars Ingebrigtsen <larsi@gnus.org> + + Add notes about command modes and nativecomp interaction + + * doc/lispref/commands.texi (Command Modes): Note interaction with + native-compile (bug#54437). + + * src/data.c: Add comment about not being supported. + + Do not merge to master. + +2022-04-13 Kyle Meyer <kyle@kyleam.com> + + Update to Org 9.5.2-25-gaf6f12 + +2022-04-13 Eli Zaretskii <eliz@gnu.org> + + Improve doc strings of read-char-from-minibuffer-insert-* commands + + * lisp/subr.el (read-char-from-minibuffer-insert-char) + (read-char-from-minibuffer-insert-other): Clarify the doc strings. + (Bug#54479) + +2022-04-13 Eli Zaretskii <eliz@gnu.org> + + Fix region highlight in non-selected windows + + * src/xdisp.c (prepare_menu_bars): Include in the windows passed + to pre-redisplay-functions windows whose point was moved from the + last recorded position. (Bug#54450) + +2022-04-13 Eli Zaretskii <eliz@gnu.org> + + Fix a regression in 'decipher-digram-list' + + * lisp/play/decipher.el (decipher-stats-buffer): Don't assume the + statistics buffer always exists. (Bug#54443) + +2022-04-13 Karl Fogel <kfogel@red-bean.com> + + Improve documentation of bookmark default sorting + + * lisp/bookmark.el (bookmark-alist, bookmark-store, + bookmark-maybe-sort-alist): Update doc strings and comments. + +2022-04-13 Juri Linkov <juri@linkov.net> + + * doc/misc/transient.texi: Fix @dircategory to "Emacs misc features" for dir. + +2022-04-13 Jim Porter <jporterbugs@gmail.com> + + Fix evaluation of negated argument predicates in Eshell + + * lisp/eshell/em-pred.el (eshell-add-pred-func): Let-bind 'pred' so + the lambdas see the original value (bug#54369). + + Committed on the wrong branch. + + Do not merge to master. + +2022-04-13 Eli Zaretskii <eliz@gnu.org> + + Emacs pretest 28.0.92 + + * README: + * configure.ac: + * nt/README.W32: + * msdos/sed2v2.inp: Bump Emacs version to 28.0.92. + + * etc/AUTHORS: + * lisp/ldefs-boot.el: Update for pretest 28.0.92. + + * ChangeLog.3: Regenerate. + +2022-04-13 Eli Zaretskii <eliz@gnu.org> + + Fix regression in 'custom-prompt-customize-unsaved-options' + + * lisp/cus-edit.el (custom-prompt-customize-unsaved-options): + Don't depend on the value returned by 'customize-unsaved'. Fix + the doc string. Patch by Sebastian Miele <iota@whxvd.name>. + (Bug#54329) + +2022-04-13 Eli Zaretskii <eliz@gnu.org> + + Improve documentation of 'map-charset-chars' + + * doc/lispref/nonascii.texi (Character Sets): + * src/charset.c (Fmap_charset_chars): Clarify the codepoint issue + in using 'map-charset-chars'. + +2022-04-13 Eli Zaretskii <eliz@gnu.org> + + Avoid assertion violations in 'bidi_resolve_brackets' + + * src/bidi.c (bidi_resolve_brackets): Move assertion to where it + really matters. (Bug#54295) + +2022-04-13 Lars Ingebrigtsen <larsi@gnus.org> + + Fix which-func-update doc string + + * lisp/progmodes/which-func.el (which-func-update): Make the doc + string match the code (bug#54288). + +2022-04-13 Eli Zaretskii <eliz@gnu.org> + + Improve wording of 'dired-jump's description + + * doc/emacs/dired.texi (Dired Enter): Clarify wording. Reported + by Natalie <batalie@riseup.net>. + +2022-04-13 Lars Ingebrigtsen <larsi@gnus.org> + + Add a comment for previous browse-url-of-dired-file change + + * lisp/net/browse-url.el (browse-url-of-dired-file): Add a comment + for previous change. + +2022-04-13 Lars Ingebrigtsen <larsi@gnus.org> + + Restore documented Emacs 27.2 behaviour of browse-url-of-dired-file + + * lisp/net/browse-url.el (browse-url-of-dired-file): Restore the + documented behaviour -- open a web browser instead of passing to + the various handlers. + +2022-04-13 Kyle Meyer <kyle@kyleam.com> + + Update to Org 9.5.2-24-g668205 + +2022-04-13 Andreas Schwab <schwab@linux-m68k.org> + + * lib-src/seccomp-filter.c (main): Use faccessat2 only if defined. + +2022-04-13 Lars Ingebrigtsen <larsi@gnus.org> + + Fix regression in derived-mode-init-mode-variables + + * lisp/emacs-lisp/derived.el (derived-mode-init-mode-variables): + Fix regression caused by lexical-binding derived.el (bug#54240). + +2022-04-13 Eli Zaretskii <eliz@gnu.org> + + Avoid crashes when fringe bitmaps are defined in daemon mode + + * src/dispextern.h (gui_define_fringe_bitmap): Add prototype. + (max_used_fringe_bitmap): Add declaration. + * src/fringe.c (gui_define_fringe_bitmap): New function. + * src/w32term.c (w32_draw_fringe_bitmap): + * src/xterm.c (x_draw_fringe_bitmap) [USE_CAIRO]: Call + 'gui_define_fringe_bitmap' if the terminal-specific bitmap data is + not available when a fringe bitmap is about to be drawn. Don't + try to draw a bitmap that is not known to fringe.c. (Bug#54183) + +2022-04-13 Eli Zaretskii <eliz@gnu.org> + + One more fix of the BPA implementation + + * src/bidi.c (bidi_find_bracket_pairs): Disable BPA optimization + when there are no strong directional characters inside the + bracketed pair. (Bug#54219) + +2022-04-13 Eli Zaretskii <eliz@gnu.org> + + Fix handling of brackets in BPA + + * src/bidi.c (bidi_resolve_brackets): Fix implementation of UBA's + N0 rule when there are no strong directional characters inside the + bracketed pair. (Bug#54219) + +2022-04-13 Po Lu <luangruo@yahoo.com> + + Correct etc/NEWS entry about bitmapped fonts + + * etc/NEWS: Don't say that bitmap font issues are due to Pango, that's + not accurate. + +2022-04-13 Jim Porter <jporterbugs@gmail.com> + + Improve/correct documentation about Eshell variable expansion + + * lisp/eshell/esh-var.el: Correct documentation comment. + (eshell-parse-variable-ref): Correct docstring. + + * doc/misc/eshell.texi (Dollars Expansion): Add documentation for + $"var"/$'var' and $<command> syntaxes. + +2022-04-13 Jim Porter <jporterbugs@gmail.com> + + Partially revert b03f74e0f2a578b1580e8b1c368665850ee7f808 + + That commit regressed '$<command>' forms in Eshell, due to a + limitation/bug in how 'eshell-do-eval' works. This fixes + bug#54190. + + * lisp/eshell/esh-var.el (eshell-parse-variable-ref): Quote a lambda. + + * test/lisp/eshell/eshell-tests.el (eshell-test/interp-temp-cmd): + New test. + +2022-04-13 Paul Eggert <eggert@cs.ucla.edu> + + Backport: Port pre-commit hook to Git 2.35.0 + + * build-aux/git-hooks/pre-commit: Use LC_ALL=C grep -E instead of + sane_egrep (removed in Git 2.35.0). + + (cherry picked from commit b8a96f055624f86fe965a0d1b7b2495b2db80e63) + +2022-04-13 Lars Ingebrigtsen <larsi@gnus.org> + + Fix :tag for eol in tab-first-completion + + * lisp/indent.el (tab-first-completion): Fix the :tag description + (bug#54179). + +2022-04-13 Kyle Meyer <kyle@kyleam.com> + + Update to Org 9.5.2-22-g33543d + +2022-04-13 Dmitry Gutov <dgutov@yandex.ru> + + Add explicit '--no-heading' for ripgrep + + * lisp/progmodes/xref.el (xref-search-program-alist): + Add explicit '--no-heading' for ripgrep (bug#54177). + +2022-04-13 Michael Albinus <michael.albinus@gmx.de> + + Follow OpenSSH changes in Tramp + + * lisp/net/tramp-sh.el (tramp-ssh-controlmaster-options): + Reimplement. OpenSSH has changed its diagnostics messages. + +2022-04-13 Eli Zaretskii <eliz@gnu.org> + + Document better how to reset attributes of faces for new frames + + * doc/lispref/display.texi (Attribute Functions): + * lisp/faces.el (set-face-attribute): Explain how to reset an + attribute's value for future frames. (Bug#54156) + +2022-04-13 Michael Albinus <michael.albinus@gmx.de> + + * lisp/net/tramp-sh.el (tramp-ssh-controlmaster-options): Adapt test. + +2022-04-13 Lars Ingebrigtsen <larsi@gnus.org> + + Mention flyspell-prog-mode in flyspell-mode doc string + + * lisp/textmodes/flyspell.el (flyspell-mode): Mention + flyspell-prog-mode (bug#54131). + +2022-04-13 Lars Ingebrigtsen <larsi@gnus.org> + + Reword face-remap-add-relative manual entry + + * doc/lispref/display.texi (Face Remapping): Clarify the + face-remap-add-relative (bug#54114). + +2022-04-13 Philipp Stephani <phst@google.com> + + Fix indexing of module functions that return enumeration types. + + Return types that consist of more than one word need to be enclosed in + braces, see Info node `(texinfo) Typed Functions'. Otherwise they are + indexed incorrectly. + + * doc/lispref/internals.texi (Module Misc, Module Nonlocal): Enclose + multi-word return types in braces. + +2022-04-13 Eli Zaretskii <eliz@gnu.org> + + * doc/misc/transient.texi (Other Options): Fix a @ref. (Bug#54108) + +2022-04-13 Glenn Morris <rgm@gnu.org> + + tramp.texi texinfo 4.13 compatibility + + * doc/misc/tramp.texi (Frequently Asked Questions): + Restore compatibility with Texinfo < 5. + +2022-04-13 Michael Albinus <michael.albinus@gmx.de> + + Explain "Tramp" spelling in its manual + + * doc/misc/tramp.texi (Frequently Asked Questions): + Explain "Tramp" spelling. + +2022-04-13 Eli Zaretskii <eliz@gnu.org> + + Fix 'display-line-numbers-mode' in hide-show buffers + + * src/xdisp.c (redisplay_internal): Disable redisplay + optimizations that consider just the current line, when + 'display-line-numbers-mode' is turned on in the buffer. + (Bug#54091) + +2022-04-13 Martin Rudalics <rudalics@gmx.at> + + Don't check whether a deleted window is deletable (Bug#54028) + + * lisp/window.el (window-state-put): Make sure window is live + before calling 'window-deletable-p' on it (Bug#54028). + +2022-04-13 Eli Zaretskii <eliz@gnu.org> + + A friendlier error message from image-mode in an empty buffer + + * lisp/image-mode.el (image-mode): Handle the case where the empty + buffer doesn't visit a file (Bug#54084) + +2022-04-13 Kyle Meyer <kyle@kyleam.com> + + Update to Org 9.5.2-17-gea6b74 + +2022-04-13 Eli Zaretskii <eliz@gnu.org> + + Improve documentation of filling and justification commands + + * doc/lispref/text.texi (Filling): + * lisp/textmodes/fill.el (fill-region-as-paragraph) + (default-justification, set-justification, justify-current-line): + Clarify "canonicalization" of spaces and the meaning of + justification styles. (Bug#54047) + (set-justification-left, set-justification-right) + (set-justification-full): Improve wording of doc strings. + +2022-04-13 Eli Zaretskii <eliz@gnu.org> + + * lisp/progmodes/subword.el (superword-mode): Doc fix. (Bug#54045) + +2022-04-13 Philipp Stephani <phst@google.com> + + Fix indexing of module functions that return complex types. + + Return types that consist of more than one word need to be enclosed in + braces, see Info node `(texinfo) Typed Functions'. Otherwise they are + indexed incorrectly. + + * doc/lispref/internals.texi (Module Values): Enclose multi-word + return types in braces. + +2022-04-13 Po Lu <luangruo@yahoo.com> + + Prevent crashes caused by invalid locale coding systems + + * src/xterm.c (handle_one_xevent): Prevent a signal inside + `setup_coding_system' which crashes recent versions of GLib if + the locale coding system is invalid. + + Do not merge to master. + +2022-04-13 Michael Albinus <michael.albinus@gmx.de> + + Fix problem with popd for in remote shell buffers + + * lisp/shell.el (shell-prefixed-directory-name): + Use `file-local-name' for DIR. (Bug#53927) + +2022-04-13 Jonas Bernoulli <jonas@bernoul.li> + + Import texi source file for transient manual + + * doc/misc/Makefile.in: Add transient to INFO_COMMON. + * doc/misc/transient.texi: New file. + +2022-04-13 Kyle Meyer <kyle@kyleam.com> + + Update to Org 9.5.2-15-gc5ceb6 + +2022-04-13 Eli Zaretskii <eliz@gnu.org> + + Fix 'exchange-point-and-mark' in 'transient-mark-mode' + + * lisp/simple.el (exchange-point-and-mark): Don't deactivate mark + when 'transient-mark-mode' is ON. (Bug#53150) + + (cherry picked from commit 415ed4b42515ff2e6dd9b94e964b479e50c6392e) + +2022-04-13 Eli Zaretskii <eliz@gnu.org> + + Fix "C-SPC C-SPC" after "C-x C-x" + + * lisp/simple.el (exchange-point-and-mark): Fix what the command + does when 'transient-mark-mode' is OFF. (Bug#52896) + + (cherry picked from commit 19c6cad1821eb896b2ddd0f6eab030f0880ea254) + +2022-04-13 Eli Zaretskii <eliz@gnu.org> + + Fix a typo in fontset.el + + * lisp/international/fontset.el (xlfd-regexp-spacing-subnum): Fix + a typo. Reported by Greg A. Woods <woods@robohack.ca>. + +2022-04-13 Eli Zaretskii <eliz@gnu.org> + + Note in ELisp manual that too-wide images are truncated + + * doc/lispref/display.texi (Showing Images): Note that images are + truncated at the window's edge. (Bug#53952) + +2022-04-13 Andrea Corallo <akrl@sdf.org> + + * lisp/mail/emacsbug.el (report-emacs-bug): Report libgccjit status. + + * lisp/startup.el (normal-top-level): Small code move, improve 202d3be873. + +2022-04-13 Andrea Corallo <akrl@sdf.org> + + * lisp/startup.el (normal-top-level): Disable native-comp if not available + +2022-04-13 Andrea Corallo <akrl@sdf.org> + + Fix integer arithmetic miss-compilation (bug#53451) + + * lisp/emacs-lisp/comp-cstr.el (comp-cstr-set-range-for-arithm): + When one of the two sources is negated revert to set dst as + number. + * test/src/comp-tests.el (comp-tests-type-spec-tests): Add test to + verify this is effective. + +2022-04-13 Robert Pluim <rpluim@gmail.com> + + Mark flymake as compatible with emacs-26.1 + + * lisp/progmodes/flymake.el: Bump package version and set + emacs version in Package-Requires to 26.1 (Bug#53853). + +2022-04-13 Brian Leung <leungbk@posteo.net> + + flymake: Ensure compatibility with older Emacsen + + * lisp/progmodes/flymake.el (flymake--log-1): Use + replace-regexp-in-string instead of Emacs 28's + string-replace (bug#53853). + +2022-04-13 Eric Abrahamsen <eric@ericabrahamsen.net> + + Don't remove dummy.group from gnus-newsrc-alist on Gnus save + + bug#53352 + + * lisp/gnus/gnus-start.el (gnus-gnus-to-quick-newsrc-format): This + function was removing dummy.group from the global value of + `gnus-newsrc-alist' on save; we only wanted to remove it temporarily. + +2022-04-13 Bob Rogers <rogers@rgrjr.com> + + Fix ietf-drums-get-comment doc string + + * lisp/mail/ietf-drums.el (ietf-drums-get-comment): We really return + the last comment (bug#53810). + +2022-04-13 Daniel MartÃn <mardani29@yahoo.es> + + Fix typo in display.texi + + * doc/lispref/display.texi (Making Buttons): Fix typo. (Bug#53807) + +2022-04-13 Michael Albinus <michael.albinus@gmx.de> + + Revert an erroneous change in tramp-cache.el + + * lisp/net/tramp-cache.el (tramp-get-hash-table): + Use `string-match-p' instead of `string-search'. The latter one + was introduced by accident. Reported by Kai Tetzlaff <kai@tetzlaff.eu>. + +2022-04-13 Eli Zaretskii <eliz@gnu.org> + + Improve documentation of 'emacs-version' + + * doc/emacs/trouble.texi (Checklist): Mention the possibility of + invoking 'emacs-version' with a prefix argument. + + * lisp/version.el (emacs-version): Improve doc string. (Bug#53720) + +2022-04-13 Michael Albinus <michael.albinus@gmx.de> + + * etc/NEWS: Apply final fixes after proofreading. + +2022-04-13 Eli Zaretskii <eliz@gnu.org> + + Clarify documentation of a "face's font" + + * doc/lispref/display.texi (Attribute Functions) + (Face Attributes): Clarify that the :font attribute of a face and + the font returned by 'face-font' are by default for ASCII + characters. (Bug#53664) + +2022-04-13 Alan Mackenzie <acm@muc.de> + + Bind Qdebugger to Qdebug in signal_or_quit. + + * src/eval.c (signal_or_quit): Bind the correct variable, Qdebugger (not + Vdebugger) to Qdebug in the section for errors in batch jobs. + (syms_of_eval): New DEFSYM for Qdebugger. + +2022-04-13 Kyle Meyer <kyle@kyleam.com> + + Update to Org 9.5.2-13-gdd6486 + +2022-04-13 Eli Zaretskii <eliz@gnu.org> + + Fix regression in Occur Edit mode + + * lisp/replace.el (occur-after-change-function): Fix the algorithm + to find the smallest change in some corner cases. (Bug#53598) + +2022-04-13 Eli Zaretskii <eliz@gnu.org> + + Fix last change of Malayalam composition rules + + * lisp/language/indian.el (malayalam-composable-pattern): + Reinstate. Instead of removing it, add any sequence of + Malayalam characters to the existing patterns, so as not + to lose the patterns that use ZWJ and ZWNJ. (Bug#53625) + +2022-04-13 Eli Zaretskii <eliz@gnu.org> + + Fix rendering of Malayalam script + + * lisp/language/indian.el (malayalam-composable-pattern): Remove. + (script-regexp-alist): Remove 'malayalam-composable-pattern'. + Instead, pass any sequence of Malayalam codepoints to the shaping + engine. (Bug#53625) + +2022-04-13 Eli Zaretskii <eliz@gnu.org> + + Improve documentation of Occur mode + + * doc/emacs/search.texi (Other Repeating Search): Improve wording + and document Occur Edit mode better. + +2022-04-13 Alan Third <alan@idiocy.org> + + Remove debug logging + + * src/nsterm.m ([EmacsView copyRect:to:]): Remove logging as it's no + longer required. + +2022-04-13 Michael Albinus <michael.albinus@gmx.de> + + Fix error in filelock.c + + * src/filelock.c (lock_file): Move call of file name handler to + `Flock_file'. Determine lock_filename only in case + create_lockfiles is non-nil. Adapt the rest of the function accordingly. + (Flock_file): Do not check for create_lockfiles. Call file name + handler if appropriate. (Bug#53207) + +2022-04-13 Juri Linkov <juri@linkov.net> + + * lisp/frame.el (clone-frame): Filter out 'parent-id' (bug#51883). + +2022-04-13 Lars Ingebrigtsen <larsi@gnus.org> + + Partially revert a fill-region-as-paragraph regression + + * lisp/textmodes/fill.el (fill-region-as-paragraph): Revert + e186af261 (bug#53537), because it leads to regressions. (But + leave tests in place.) + +2022-04-13 Eli Zaretskii <eliz@gnu.org> + + Fix 'make_lispy_position' when there's an image at EOB + + * src/xdisp.c (move_it_to): Don't compare IT_CHARPOS with an + invalid TO_CHARPOS. (Bug#53546) + +2022-04-13 Lars Ingebrigtsen <larsi@gnus.org> + + Fix copyright-find-copyright when searching from the end + + * lisp/emacs-lisp/copyright.el (copyright-find-copyright): Make + the double check also work when searching from the end (bug#7179). + + Do not merge to master. + +2022-04-13 Lars Ingebrigtsen <larsi@gnus.org> + + Fix copyright.el comment and add a test + + * lisp/emacs-lisp/copyright.el (copyright-find-copyright): Fix + comment (bug#7179). + + Do not merge to master. + +2022-04-13 Philipp Stephani <phst@google.com> + + * configure.ac (LIBSECCOMP): Bump minimum version for faccessat2. + +2022-04-13 Lars Ingebrigtsen <larsi@gnus.org> + + Make the `f' command work in image-mode again + + * lisp/image.el (image-show-frame): Protect against not having + computed the animation data yed (bug#53489). + +2022-04-13 Philipp Stephani <phst@google.com> + + Seccomp: improve support for newer versions of glibc (Bug#51073) + + * lib-src/seccomp-filter.c (main): Allow 'pread64' and 'faccessat2' + system calls. Newer versions of glibc use these system call (starting + with commits 95c1056962a3f2297c94ce47f0eaf0c5b6563231 and + 3d3ab573a5f3071992cbc4f57d50d1d29d55bde2, respectively). + +2022-04-13 Thomas Fitzsimmons <fitzsim@fitzsim.org> + + EUDC: Fix a quoting bug in the BBDB backend + + * lisp/net/eudcb-bbdb.el (eudc-bbdb-query-internal): Fix a quoting + bug introduced during lexical-binding conversion. + +2022-04-13 Sergey Vinokurov <serg.foo@gmail.com> + + Fix memory-report-object-size to initialize memory-report--type-size + + * lisp/emacs-lisp/memory-report.el (memory-report-object-size): + Allow using function directly (bug#53310). + + Do not merge to master. + +2022-04-13 Stefan Monnier <monnier@iro.umontreal.ca> + + Fix menu-bar mouse clicks in "C-h c" and "C-h k" (bug#53322) + + * lisp/subr.el (event-start, event-end): Handle '(menu-bar)' + events. + * lisp/net/browse-url.el (browse-url-interactive-arg): Simplify + accordingly. + + (cherry picked from commit 9ceb3070e34ad8a54184fd0deda477bf5ff77000) + +2022-04-13 Eli Zaretskii <eliz@gnu.org> (tiny change) + + Fix UB in ebrowse + + * lib-src/ebrowse.c (matching_regexp): Avoid writing beyond the + limits of 'matching_regexp_buffer'. Patch by Jan Stranik + <jan@stranik.org>. (Bug#53333) + +2022-04-13 Lars Ingebrigtsen <larsi@gnus.org> + + Fix execute-extended-command-for-buffer in fundamental-mode + + * lisp/simple.el (execute-extended-command-for-buffer): Protect + against the current local map being nil (bug#52907). + +2022-04-13 Martin Rudalics <rudalics@gmx.at> + + Add workaround to handle a problem with Enlightenment WM (Bug#53298) + + * src/xterm.c (handle_one_xevent): Handle setting of variable + 'x_set_frame_visibility_more_laxly' when receiving an Expose or + FocusIn event (Bug#53298). + (Qexpose): Define symbol. + (x_set_frame_visibility_more_laxly): New Lisp variable. + * etc/PROBLEMS: Mention frame redraw problem with the + Enlightenment WM and 'x-set-frame-visibility-more-laxly' + workaround. + +2022-04-13 Po Lu <luangruo@yahoo.com> + + Fix regression leading to flickering tooltips when the mouse is moved + + * lisp/tooltip.el (tooltip-show-help): Compare string with + previous tooltip string ignoring properties. + +2022-04-13 Andrea Corallo <akrl@sdf.org> + + * Fix native comp for non trivial function names (bug#52833) + + * lisp/emacs-lisp/comp.el (comp-c-func-name): Fix native compilation + for functions with function names containing non trivial + characters (bug#52833). + + This commit is the backport of e7699bf290. + + Do not merge to master + +2022-04-13 Kyle Meyer <kyle@kyleam.com> + + Update to Org 9.5.2-9-g7ba24c + +2022-04-13 Juri Linkov <juri@linkov.net> + + * lisp/net/dictionary.el (dictionary-context-menu): Use package prefix. + +2022-04-13 Philipp Stephani <phst@google.com> + + Mark a few more map tests as unstable on Emacs 28 (Bug#46722). + + At least for me, these tests still occasionally fail. + + Do not merge to master. + + * test/lisp/emacs-lisp/map-tests.el (test-map-into-hash-test) + (test-map-merge, test-map-merge-with, test-map-merge-empty): Mark as + unstable. + +2022-04-13 Philipp Stephani <phst@google.com> + + * lisp/indent.el (tab-first-completion): Fix incorrect choices. + +2022-04-13 Philipp Stephani <phst@google.com> + + * lisp/simple.el (undo-no-redo): Fix customization group + + * lisp/progmodes/xref.el (xref-file-name-display): Fix docstring. + +2022-04-13 Eli Zaretskii <eliz@gnu.org> + + Avoid another segfault in 'face_at_buffer_position' + + * src/xfaces.c (face_at_buffer_position): Make really sure the + default face is usable. (Bug#53254) + +2022-04-13 Lars Ingebrigtsen <larsi@gnus.org> + + Mark test-map-into as unstable + + * test/lisp/emacs-lisp/map-tests.el (test-map-into): Mark as + unstable (bug#46722). + + Do not merge to master. + +2022-04-13 Philipp Stephani <phst@google.com> + + Fix Edebug specification for inline functions (Bug#53068). + + * lisp/emacs-lisp/inline.el (inline-quote): Fix Edebug specification. + + * test/lisp/emacs-lisp/edebug-tests.el (edebug-tests-inline): New unit + test. + +2022-04-13 N. Jackson <nljlistbox2@gmail.com> + + Remove mention of removed `gnus-treat-play-sounds' variable from manual + + * info/gnus.info: Remove `gnus-treat-play-sounds' from + manual. According to lisp/gnus/ChangeLog.3 this variable was + removed in 2010 (bug#53192). + +2022-04-13 Mattias EngdegÃ¥rd <mattiase@acm.org> + + Revert "Fix closure-conversion of shadowed captured lambda-lifted vars" + + This reverts commit 3ec8c8b3ae2359ceb8135b672e86526969c16b7e. + + It was committed to a stable branch without prior discussion; + see bug#53071. + +2022-04-13 Juri Linkov <juri@linkov.net> + + * doc/lispref/windows.texi (Textual Scrolling): Remove obsolete text. + + Remove text about scrolling the minibuffer from the buffer, + obsolete since Emacs 27 (bug#51210). + +2022-04-13 Glenn Morris <rgm@gnu.org> + + * lisp/files.el (lock-file-name-transforms): Doc tweaks. + +2022-04-13 Mattias EngdegÃ¥rd <mattiase@acm.org> + + Fix closure-conversion of shadowed captured lambda-lifted vars + + Lambda-lifted variables (ones passed explicitly to lambda-lifted + functions) that are also captured in an outer closure and shadowed + were renamed incorrectly (bug#51982). + + Reported by Paul Pogonyshev. + + * lisp/emacs-lisp/cconv.el (cconv--lifted-arg): New. + (cconv-convert): Provide correct definiens for the closed-over + variable. + * test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-tests--test-cases): + * test/lisp/emacs-lisp/cconv-tests.el (cconv-tests--intern-all) + (cconv-closure-convert-remap-var): Add tests. + + (cherry picked from commit 45252ad8f932c98a373ef0ab7f3363a3e27ccbe4) + +2022-04-13 Philipp Stephani <phst@google.com> + + Fix test lisp/cedet/semantic/bovine/gcc-tests on macOS (Bug#52431) + + * test/lisp/cedet/semantic/bovine/gcc-tests.el + (semantic-gcc-test-output-parser-this-machine): Also detect Apple + clang on macOS Monterey. + + (cherry picked from commit 6e52becfbe2a33c025b8c4838b3c8f06ba5a6fb8) + +2022-04-13 Mattias EngdegÃ¥rd <mattiase@acm.org> + + Don't fail flymake-tests if `gcc` actually is Clang + + * test/lisp/progmodes/flymake-tests.el (flymake-tests--gcc-is-clang) + (different-diagnostic-types, included-c-header-files): Skip tests that + depend on the `gcc` command really being GCC and not Clang. + + (cherry picked from commit b2167d98432a78442522b7564e22f47d75a98b6f) + +2022-04-13 Eli Zaretskii <eliz@gnu.org> + + Revert "Remove the filename argument from the command line after an ELC+ELN build" + + This reverts commit ffc047c896413b6e00032518fc934f08768671fa. + + Please don't install anything non-trivial on the release branch + without asking first. + +2022-04-13 Alan Mackenzie <acm@muc.de> + + Remove the filename argument from the command line after an ELC+ELN build + + This fixes bug #53164. Without this fix, bootstrap-emacs loads the source + file uselessly into a buffer after completing the compilation. + +2022-04-13 Stefan Monnier <monnier@iro.umontreal.ca> + + (save-some-buffers): Simplify the fix for bug#46374 + + * lisp/files.el (save-some-buffers): Only check the + `save-some-buffers-function` property on functions from + `save-some-buffers-default-predicate` since callers which provide + a `pred` argument can arrange to compute `pred` themselves if needed. + + * test/lisp/files-tests.el (files-tests-buffer-offer-save): Don't test + with `pred` set to `save-some-buffers-root` since it's not an + appropriate function for that any more. + +2022-04-13 Stefan Kangas <stefan@marxist.se> + + Improve docstring of edit-abbrevs + + * lisp/abbrev.el (edit-abbrevs): Doc fix; don't use obsolete name. + Improve docstring formatting. + +2022-04-13 Eli Zaretskii <eliz@gnu.org> + + Revert "Fix alignment on font size change in tabulated-list-mode" + + This reverts commit 2767c89db729a6106146d0aeff76678c64d4fc53. + + That change caused a regression in a much more important use + case, see bug#53133. + +2022-04-13 Stefan Kangas <stefan@marxist.se> + + Clarify docstring of package-native-compile + + * lisp/emacs-lisp/package.el (package-native-compile): Clarify + docstring. + +2022-04-13 Eli Zaretskii <eliz@gnu.org> + + Fix Subject "simplification" in Rmail + + * lisp/mail/rmail.el (rmail-simplified-subject): Match against + "[external]" _after_ decoding the Subject by RFC-2047. + +2022-04-13 Stefan Kangas <stefan@marxist.se> + + Bump Emacs version to 28.0.91 + + * README: + * configure.ac: + * msdos/sed2v2.inp: + * nt/README.W32: Bump Emacs version to 28.0.91. + 2022-01-05 Dmitry Gutov <dgutov@yandex.ru> Fix vc-git with old Git over Tramp and cygwin-mount.el @@ -234065,6 +234978,7 @@ This file records repository revisions from commit 9d56a21e6a696ad19ac65c4b405aeca44785884a (exclusive) to +2022-04-13e39829812098d8269eafbc0fcb98959ee5bb7 (inclusive). commit e7aa3ece52d26cc7e4d3f3990aff56127389779f (inclusive). See ChangeLog.2 for earlier changes. @@ -243,6 +243,11 @@ This build is only supported with GTK+ version 3, and it is an error to specify any other X-specific configuration option when PGTK is enabled. +If you use exclusively X, do not use the PGTK port. There are a +number of respects in which the regular --with-x-toolkit=gtk build +works better. The PGTK port should not be considered a simple upgrade +from --with-x-toolkit=gtk. + With the PGTK build, you will be able to switch between running Emacs on X, Wayland and Broadway using the 'GDK_BACKEND' environment variable. GTK+ should automatically detect and use the correct value @@ -353,9 +358,9 @@ Use --without-toolkit-scroll-bars to disable Motif or Xaw3d scroll bars. Use --without-xim to inhibit the default use of X Input Methods. In this case, the X resource useXIM can be used to turn on use of XIM. -Use --with-xinput2 to enable the use of version 2 of the X Input -Extension. This enables support for touchscreens, pinch gestures, and -scroll wheels that report scroll deltas at pixel-level precision. +Use --without-xinput2 to disable the use of version 2 of the X Input +Extension. This disables support for touchscreens, pinch gestures, +and scroll wheels that report scroll deltas at pixel-level precision. Use --disable-largefile to omit support for files larger than 2GB, and --disable-year2038 to omit support for timestamps past the year 2038, diff --git a/admin/CPP-DEFINES b/admin/CPP-DEFINES index 620ab0bed05..06986ec8f48 100644 --- a/admin/CPP-DEFINES +++ b/admin/CPP-DEFINES @@ -24,6 +24,7 @@ DARWIN_OS Compiling on macOS or pure Darwin (and using s/darwin.h). SOLARIS2 USG USG5_4 +HAIKU Compiling on Haiku. ** Distinguishing GUIs ** @@ -32,16 +33,38 @@ HAVE_NS Use the NeXT/OpenStep/Cocoa UI under macOS or GNUstep. NS_IMPL_GNUSTEP Compile support for GNUstep implementation of NS GUI API. NS_IMPL_COCOA Compile support for Cocoa (Apple) implementation of NS GUI API. HAVE_X11 Compile support for the X11 GUI. +HAVE_PGTK Compile support for using GTK itself without directly using X Windows APIs. +HAVE_HAIKU Compile support for the Haiku window system. HAVE_X_WINDOWS Compile support for X Window system (It looks like, nowadays, if HAVE_X11 is set, HAVE_X_WINDOWS must be, and vice versa. At least, this is true for configure, and msdos; not sure about nt.) -HAVE_X11R6 -HAVE_X11R6_XIM -HAVE_X11XTR6 + +** X Windows features ** +HAVE_X11R6 Whether or not the system has X11R6. (Always defined.) +HAVE_X11R6_XIM Whether or not the system supports XIM features introduced in R6. +HAVE_X11XTR6 Whether or not the Xt is from X11R6 or newer. + USE_LUCID Use the Lucid toolkit for menus&scrollbars. Requires HAVE_X11. USE_MOTIF Use the Motif toolkit for menus&scrollbars. Requires HAVE_X11. -USE_GTK Use the Gtk toolkit for menus&scrollbars. Requires HAVE_X11. +USE_GTK Use the Gtk toolkit for menus&scrollbars. Requires HAVE_X11 or HAVE_PGTK. +HAVE_GTK3 Use GTK version 3 or later. Requires HAVE_X11. + +HAVE_XCB_SHAPE Whether or not XCB supports the Nonrectangular Window Shape extension. +HAVE_XCOMPOSITE Whether or not the XCOMPOSITE extension library is present. +HAVE_XDBE Whether or not to use the Xdbe extension for double buffering. +HAVE_XFIXES Whether or not the Xfixes extension library is present. +HAVE_XINERAMA Whether or not the Xinerama extension library is present. +HAVE_XINPUT2 Whether or not to use version 2 of the X Input Extension for input. +HAVE_XINPUT2_1 Whether or not version 2.1 of the X Input Extension is supported. +HAVE_XINPUT2_2 Whether or not version 2.2 of the X Input Extension is supported. +HAVE_XINPUT2_3 Whether or not version 2.3 of the X Input Extension is supported. +HAVE_XINPUT2_4 Whether or not version 2.4 of the X Input Extension is supported. +HAVE_XKB Whether or not the XKB extension library is present. +HAVE_XRANDR Whether or not the RandR extension library is present. +HAVE_XSHAPE Whether or not the Nonrectangular Window Shape extension library is present. +HAVE_XSYNC Whether or not the X Synchronization Extension library is present. +USE_XCB Whether or not the XCB library is used to optimize some X requests. ** Frame types ** diff --git a/admin/admin.el b/admin/admin.el index 5f02ea8ce45..8c68b181831 100644 --- a/admin/admin.el +++ b/admin/admin.el @@ -602,76 +602,81 @@ style=\"text-align:left\">") (forward-line 1) (setq done t))))) (let (done open-td tag desc) - ;; Convert the list that Makeinfo made into a table. - (or (search-forward "<ul class=\"menu\">" nil t) - ;; FIXME? The following search seems dangerously lax. - (search-forward "<ul>")) - (replace-match "<table style=\"float:left\" width=\"100%\">") - (forward-line 1) - (while (not done) - (cond - ((or (looking-at "<li>\\(<a.+</a>\\):[ \t]+\\(.*\\)$") - (looking-at "<li>\\(<a.+</a>\\)$")) - (setq tag (match-string 1)) - (setq desc (match-string 2)) - (replace-match "" t t) - (when open-td - (save-excursion - (forward-char -1) - (skip-chars-backward " ") - (delete-region (point) (line-end-position)) - (insert "</td>\n </tr>"))) - (insert " <tr>\n ") - (if table-workaround - ;; This works around a Firefox bug in the mono file. - (insert "<td bgcolor=\"white\">") - (insert "<td>")) - (insert tag "</td>\n <td>" (or desc "")) - (setq open-td t)) - ((eq (char-after) ?\n) - (delete-char 1) - ;; Negate the following `forward-line'. - (forward-line -1)) - ((looking-at "<!-- ") - (search-forward "-->")) - ((looking-at "<p>[- ]*The Detailed Node Listing[- \n]*") - (replace-match " </td></tr></table>\n + ;; Texinfo 6.8 and later doesn't produce <ul class="menu"> lists + ;; for the TOC menu, and the "description" part of each menu + ;; item is not there anymore. So for HTML manuals produced by + ;; those newer versions of Texinfo we punt and leave the menu in + ;; its original form. + (when (or (search-forward "<ul class=\"menu\">" nil t) + ;; FIXME? The following search seems dangerously lax. + (search-forward "<ul>")) + ;; Convert the list that Makeinfo made into a table. + (replace-match "<table style=\"float:left\" width=\"100%\">") + (forward-line 1) + (while (not done) + (cond + ((or (looking-at "<li>\\(<a.+</a>\\):[ \t]+\\(.*\\)$") + (looking-at "<li>\\(<a.+</a>\\)$")) + (setq tag (match-string 1)) + (setq desc (match-string 2)) + (replace-match "" t t) + (when open-td + (save-excursion + (forward-char -1) + (skip-chars-backward " ") + (delete-region (point) (line-end-position)) + (insert "</td>\n </tr>"))) + (insert " <tr>\n ") + (if table-workaround + ;; This works around a Firefox bug in the mono file. + (insert "<td bgcolor=\"white\">") + (insert "<td>")) + (insert tag "</td>\n <td>" (or desc "")) + (setq open-td t)) + ((eq (char-after) ?\n) + (delete-char 1) + ;; Negate the following `forward-line'. + (forward-line -1)) + ((looking-at "<!-- ") + (search-forward "-->")) + ((looking-at "<p>[- ]*The Detailed Node Listing[- \n]*") + (replace-match " </td></tr></table>\n <h3>Detailed Node Listing</h3>\n\n" t t) - (search-forward "<p>") - ;; FIXME Fragile! - ;; The Emacs and Elisp manual have some text at the - ;; start of the detailed menu that is not part of the menu. - ;; Other manuals do not. - (if (looking-at "Here are some other nodes") - (search-forward "<p>")) - (goto-char (match-beginning 0)) - (skip-chars-backward "\n ") - (setq open-td nil) - (insert "</p>\n\n<table style=\"float:left\" width=\"100%\">")) - ((looking-at "</li></ul>") - (replace-match "" t t)) - ((looking-at "<p>") - (replace-match "" t t) - (when open-td - (insert " </td></tr>") - (setq open-td nil)) - (insert " <tr> + (search-forward "<p>") + ;; FIXME Fragile! + ;; The Emacs and Elisp manual have some text at the + ;; start of the detailed menu that is not part of the menu. + ;; Other manuals do not. + (if (looking-at "Here are some other nodes") + (search-forward "<p>")) + (goto-char (match-beginning 0)) + (skip-chars-backward "\n ") + (setq open-td nil) + (insert "</p>\n\n<table style=\"float:left\" width=\"100%\">")) + ((looking-at "</li></ul>") + (replace-match "" t t)) + ((looking-at "<p>") + (replace-match "" t t) + (when open-td + (insert " </td></tr>") + (setq open-td nil)) + (insert " <tr> <th colspan=\"2\" align=\"left\" style=\"text-align:left\">") - (if (re-search-forward "</p>[ \t\n]*<ul class=\"menu\">" nil t) - (replace-match " </th></tr>"))) - ((looking-at "[ \t]*</ul>[ \t]*$") - (replace-match - (if open-td - " </td></tr>\n</table>" - "</table>") t t) - (setq done t)) - (t - (if (eobp) - (error "Parse error in %s" - (file-name-nondirectory buffer-file-name))) - (unless open-td - (setq done t)))) - (forward-line 1))))) + (if (re-search-forward "</p>[ \t\n]*<ul class=\"menu\">" nil t) + (replace-match " </th></tr>"))) + ((looking-at "[ \t]*</ul>[ \t]*$") + (replace-match + (if open-td + " </td></tr>\n</table>" + "</table>") t t) + (setq done t)) + (t + (if (eobp) + (error "Parse error in %s" + (file-name-nondirectory buffer-file-name))) + (unless open-td + (setq done t)))) + (forward-line 1)))))) (defconst make-manuals-dist-output-variables diff --git a/admin/cus-test.el b/admin/cus-test.el index 8f0914ff691..5894abed3df 100644 --- a/admin/cus-test.el +++ b/admin/cus-test.el @@ -156,7 +156,7 @@ Names should be as they appear in loaddefs.el.") "Set by `cus-test-apropos' to a list of options with :get property.") (defvar cus-test-vars-with-changed-state nil - "Set by `cus-test-apropos' to a list of options with state 'changed.") + "Set by `cus-test-apropos' to a list of options with state \\='changed.") (defvar cus-test-deps-errors nil "List of require/load problems found by `cus-test-deps'.") diff --git a/admin/make-tarball.txt b/admin/make-tarball.txt index ec69302dae8..c8ee3349cdb 100644 --- a/admin/make-tarball.txt +++ b/admin/make-tarball.txt @@ -54,12 +54,31 @@ General steps (for each step, check for possible errors): section at the beginning of that file, and commit etc/NEWS if it was modified. -2. Regenerate the etc/AUTHORS file: +2. Regenerate the versioned ChangeLog.N and etc/AUTHORS files. + + The "M-x authors" command below will first update the current + versioned ChangeLog.N file. For this to work correctly, make sure + the top-level Makefile says + + PREFERRED_BRANCH = emacs-NN + + where NN is the version on the release branch from which you are + producing the tarball. If NN is incorrect, update Makefile.in and + re-run 'configure' to update Makefile. + + If the versioned ChangeLog.N file is too large, start a new one + by bumping N, and also update the line in top-level Makefile.in + which says + + CHANGELOG_HISTORY_INDEX_MAX = N + + by incrementing the value of N by 1; then regenerate Makefile. + + Now: + M-: (require 'authors) RET M-x authors RET - (This first updates the current versioned ChangeLog.N) - If this says "Problem updating ChangeLog", find the reason for the failure of the command it runs, viz.: @@ -315,17 +334,74 @@ looks like this: </div> </div> -Regenerate the various manuals in manual/. -The scripts admin/make-manuals and admin/upload-manuals summarize the process. - -If you have Texinfo installed locally, make-manuals might fail if it -cannot find epsf.tex. In that case define in the environment - - TEXINPUTS=:/path/to/texinfo-tree/doc - -where /path/to/texinfo-tree is the absolute file name of the top-level -directory where you have the Texinfo source tree. Then re-run -make-manuals. +The file download.html may need to be updated, for example if the +MS-Windows binaries will be signed by a different person/key than +those mentioned there. + +Next, regenerate the various manuals in HTML, PDF, and PS formats: + + Invoke ./admin/make-manuals from the top-level directory of the + Emacs source tree that contains the manuals for which you want to + produce HTML docs. This creates the 'manual' directory and + populates it with the necessary files. + + If you have Texinfo installed locally, make-manuals might fail if it + cannot find epsf.tex. In that case define in the environment + + TEXINPUTS=:/path/to/texinfo-tree/doc + + where /path/to/texinfo-tree is the absolute file name of the + top-level directory where you have the Texinfo source tree. Then + re-run make-manuals. + + make-manuals can also fail if the HTML manuals produced by Texinfo + violate some of the assumptions admin/admin.el makes about the + format of the produced HTML. Debug these problems and resolve them, + then re-run make-manuals. (Each time you run make-manuals, it + empties the manuals/ directory and regenerates the files there, but + if the files in manuals/ can be used without regeneration, i.e. if + the problem you solved doesn't affect the produced HTML, you can + invoke make-manuals with the -c switch, which will make the process + much faster.) + +Now change to the 'manual' directory and invoke upload-manuals: + + ../admin/updload-manuals /path/to/webpages/cvs/checkout + + where /path/to/webpages/cvs/checkout is the place where you have the + CVS checkout of the Emacs Web pages, with subdirectories 'manual' + and 'refcards'. This moves the produced manuals to directories in + the Web pages CVS checkout tree, and also invokes CVS commands to + commit changed files, add new files, and remove stale files that are + no longer part of the manuals. + + If upload-manuals fails, resolve the problems and re-invoke it. + This requires running make-manuals again, since upload-manuals + destructively modifies the 'manual' directory where you invoke it. + Also, upload-manuals invokes "cvs commit -f", so if you run it + several times, some files will be committed more than once even + though they were not changed in-between. Suck it up. + + All the added and removed files need to be committed, so next fire + up Emacs, type "C-x v d" to invoke vc-dir on the Web pages checkout, + and use "C-x v v" and other VC commands to commit all the files that + upload-manuals didn't automatically commit. (You can also do that + with manual CVS commands, of course, but this is not recommended.) + + Next, make sure that manual/index.html file is consistent with the + info/dir file in the branch for which you are producing the manuals, + in that it mentions all the manuals. It could be outdated if + manuals were added or removed since the last release. + + For each new manual, a file manual/MANUAL.html (where MANUAL is the + name of the manual) should be created from the template in + manual/eww.html, after editing the title and the Copyright years, + and the links in it changed to point to the appropriate files in the + manual/html_node/ and manual/html_mono/ subdirectories. + + In addition, the file refcards/index.html should be audited to make + sure it includes the up-to-date list of refcards actually produced + and put under that subdirectory. Browsing <https://web.cvs.savannah.gnu.org/viewvc/?root=emacs> is one way to check for any files that still need updating. diff --git a/admin/notes/unicode b/admin/notes/unicode index 41661995000..f699f4fb1c0 100644 --- a/admin/notes/unicode +++ b/admin/notes/unicode @@ -36,6 +36,12 @@ copyright.html in admin/unidata (some of them might need trailing whitespace removed before they can be committed to the Emacs repository). +Next, review the assignment of default values of the Bidi Class +property to blocks in the file extracted/DerivedBidiClass.txt from the +UCD (search for "unassigned" in that file). Any changes should be +reflected in the unidata-gen.el file, where it sets up the default +values around line 210. + Then Emacs should be rebuilt for them to take effect. Rebuilding Emacs updates several derived files elsewhere in the Emacs source tree, mainly in lisp/international/. diff --git a/admin/unidata/unidata-gen.el b/admin/unidata/unidata-gen.el index ad72eed9955..149f7535588 100644 --- a/admin/unidata/unidata-gen.el +++ b/admin/unidata/unidata-gen.el @@ -209,9 +209,15 @@ Property value is one of the following symbols: ;; The assignment of default values to blocks of code points ;; follows the file DerivedBidiClass.txt from the Unicode ;; Character Database (UCD). - (L (#x0600 #x06FF AL) (#xFB50 #xFDFF AL) (#xFE70 #xFEFF AL) - (#x0590 #x05FF R) (#x07C0 #x08FF R) - (#xFB1D #xFB4F R) (#x10800 #x10FFF R) (#x1E800 #x1EFFF R)) + (L (#x0600 #x07BF AL) (#x0860 #x08FF AL) (#xFB50 #xFDCF AL) + (#xFDF0 #xFDFF AL) (#xFE70 #xFEFF AL) (#x10D00 #x10D3F AL) + (#x10F30 #x10F6F AL) (#x1EC70 #x1ECBF AL) (#x1ED00 #x1ED4F AL) + (#x1EE00 #x1EEFF AL) + (#x0590 #x05FF R) (#x07C0 #x085F R) (#xFB1D #xFB4F R) + (#x10800 #x10CFF R) (#x10D40 #x10F2F R) (#x10F70 #x10FFF R) + (#x1E800 #x1EC6F R) (#x1ECC0 #x1ECFF R) (#x1ED50 #x1EDFF R) + (#x1EF00 #x1EFFF R) + (#x20A0 #x20CF ET)) ;; The order of elements must be in sync with bidi_type_t in ;; src/dispextern.h. (L R EN AN BN B AL LRE LRO RLE RLO PDF LRI RLI FSI PDI diff --git a/admin/upload-manuals b/admin/upload-manuals index 1fa9865e657..1b7950ede80 100755 --- a/admin/upload-manuals +++ b/admin/upload-manuals @@ -334,7 +334,10 @@ for d in html_node/*; do [ -e $webdir/manual/$d ] || { echo "New directory: $d" mkdir $webdir/manual/$d - $cvs add $webdir/manual/$d || die "add error" + ( + cd $webdir/manual + $cvs add $d || die "add error" + ) } new= diff --git a/configure.ac b/configure.ac index 185e4d08623..484ce980a52 100644 --- a/configure.ac +++ b/configure.ac @@ -490,7 +490,7 @@ OPTION_DEFAULT_ON([modules],[don't compile with dynamic modules support]) OPTION_DEFAULT_ON([threads],[don't compile with elisp threading support]) OPTION_DEFAULT_OFF([native-compilation],[compile with Emacs Lisp native compiler support]) OPTION_DEFAULT_OFF([cygwin32-native-compilation],[use native compilation on 32-bit Cygwin]) -OPTION_DEFAULT_OFF([xinput2],[use version 2 of the X Input Extension for input]) +OPTION_DEFAULT_ON([xinput2],[don't use version 2 of the X Input Extension for input]) AC_ARG_WITH([file-notification],[AS_HELP_STRING([--with-file-notification=LIB], [use a file notification library (LIB one of: yes, inotify, kqueue, gfile, w32, no)])], @@ -1105,6 +1105,8 @@ AS_IF([test $gl_gcc_warnings = no], if test "$emacs_cv_clang" = yes; then gl_WARN_ADD([-Wno-missing-braces]) gl_WARN_ADD([-Wno-null-pointer-arithmetic]) + gl_WARN_ADD([-Wno-implicit-const-int-float-conversion]) + gl_WARN_ADD([-Wno-int-in-bool-context]) fi # This causes too much noise in the MinGW build @@ -2797,7 +2799,11 @@ gtk3_pkg_errors= if test "${opsys}" != "mingw32"; then if test "${with_gtk3}" = "yes" || test "${with_gtk}" = "yes" || test "$USE_X_TOOLKIT" = "maybe"; then GLIB_REQUIRED=2.37.5 - GTK_REQUIRED=3.10 + if test "${window_system}" = "x11"; then + GTK_REQUIRED=3.10 + else + GTK_REQUIRED=3.20 + fi GTK_MODULES="gtk+-3.0 >= $GTK_REQUIRED glib-2.0 >= $GLIB_REQUIRED" dnl Checks for libraries. @@ -2933,6 +2939,8 @@ fi AC_SUBST(PGTK_OBJ) AC_SUBST(PGTK_LIBS) +AC_CHECK_FUNCS(malloc_trim) + dnl D-Bus has been tested under GNU/Linux only. Must be adapted for dnl other platforms. HAVE_DBUS=no @@ -4120,7 +4128,7 @@ if test "${with_native_compilation}" != "no"; then MAC_CFLAGS="-I$(dirname $($BREW ls -v libgccjit | \ grep libgccjit.h))" MAC_LIBS="-L$(dirname $($BREW ls -v libgccjit| \ - grep libgccjit.so\$))" + grep -E 'libgccjit\.(so|dylib)$'))" fi fi diff --git a/doc/emacs/building.texi b/doc/emacs/building.texi index 5b68b1ef9fa..994ad460333 100644 --- a/doc/emacs/building.texi +++ b/doc/emacs/building.texi @@ -138,6 +138,14 @@ of environment variable settings; each element should be a string of the form @code{"@var{envvarname}=@var{value}"}. These environment variable settings override the usual ones. +@vindex compilation-max-output-line-length + Displaying extremely long lines in compilation output can slow Emacs +down. Lines that are longer than +@code{compilation-max-output-line-length} will have the portion that's +exceeds that limit hidden behind a button that can be clicked on to +reveal the hidden portion. Set this variable to @code{nil} to never +hide anything. + @node Compilation Mode @section Compilation Mode @@ -1734,6 +1742,10 @@ which is provided for evaluating Emacs Lisp expressions interactively. Its major mode is Lisp Interaction mode. You can also enable Lisp Interaction mode by typing @kbd{M-x lisp-interaction-mode}. +@findex scratch-buffer + If you kill the @file{*scratch*} buffer, you can recreate it with +the @kbd{M-x scratch-buffer} command. + @findex eval-print-last-sexp @kindex C-j @r{(Lisp Interaction mode)} In the @file{*scratch*} buffer, and other Lisp Interaction mode diff --git a/doc/emacs/cmdargs.texi b/doc/emacs/cmdargs.texi index de1d5e0b2c3..946afb6fc14 100644 --- a/doc/emacs/cmdargs.texi +++ b/doc/emacs/cmdargs.texi @@ -294,6 +294,22 @@ which will invoke Emacs with @samp{--script} and supply the name of the script file as @var{file}. Emacs Lisp then treats the @samp{#!} on this first line as a comment delimiter. +@item -x +@opindex -x +This option can only be used in executable script files, and should be +invoked like this: + +@example +#!/usr/bin/emacs -x +@end example + +This is like @samp{--script}, but suppresses loading the init files +(like @code{--quick}), and can't be used on a normal command line +(since it doesn't specify the script to load). In addition, when it +reaches the end of the script, it exits Emacs and uses the value of +the final form as the exit value from the script (if the final value +is numerical). Otherwise, it will always exit with a zero value. + @item --no-build-details @opindex --no-build-details @cindex build details diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi index a3c9c7c206a..46a2291b74d 100644 --- a/doc/emacs/custom.texi +++ b/doc/emacs/custom.texi @@ -1232,6 +1232,28 @@ Manual}. These four keywords are not really variables; setting them in any other context has no special meaning. + If you're editing a file across Emacs versions, and a new mode has +been introduced to handle a file in a newer Emacs version, you can use +several @code{mode} entries to use the new mode (called +@code{my-new-mode}) in the new Emacs, and fall back to the old mode +(called @code{my-old-mode}) in older Emacs versions. If you're +enabling the modes in the first line of the file, can say: + +@example +-*- mode: my-old; mode: my-new -*- +@end example + + Emacs will use the final defined mode it finds, so in older Emacs +versions it will ignore @code{my-new-mode}, while in Emacs versions +where @code{my-new-mode} is defined, it'll ignore @code{my-old-mode}. +Similarly, in a local variable block at the end of the file: + +@example +Local variables: +mode: my-old +mode: my-new +@end example + Do not use the @code{mode} keyword for minor modes. To enable or disable a minor mode in a local variables list, use the @code{eval} keyword with a Lisp expression that runs the mode command diff --git a/doc/emacs/dired.texi b/doc/emacs/dired.texi index 27df269ce7b..92106ae1ed3 100644 --- a/doc/emacs/dired.texi +++ b/doc/emacs/dired.texi @@ -776,6 +776,11 @@ symbolic links as links or after dereferencing (like @samp{cp -L}). The default is @code{nil}, which means that the symbolic links are copied by creating new ones. +@vindex dired-keep-marker-copy +The @code{dired-keep-marker-copy} user option controls how this +command handles file marking. The default is to mark all new copies +of files with a @samp{C} mark. + @item D @findex dired-do-delete @kindex D @r{(Dired)} diff --git a/doc/emacs/display.texi b/doc/emacs/display.texi index 534bf5881e7..7a6c7f391b9 100644 --- a/doc/emacs/display.texi +++ b/doc/emacs/display.texi @@ -1899,12 +1899,22 @@ logical lines, so having a fringe indicator for each wrapped line would be visually distracting. You can change this by customizing the variable @code{visual-line-fringe-indicators}. +@vindex word-wrap-whitespace-mode + By default, Emacs only breaks lines after whitespace characters like +@key{SPC} and @key{TAB}, but does not break after whitespace +characters like @key{EN QUAD}. Emacs provides a minor mode called +@code{word-wrap-whitespace-mode} that switches on word wrapping in the +current mode, and sets up which characters to wrap lines on based on +the @code{word-wrap-whitespace-characters} user option. There's also +a globalized version of that mode called +@code{global-word-wrap-whitespace-mode}. + @vindex word-wrap-by-category @findex modify-category-entry @findex char-category-set @findex category-set-mnemonics - By default, Emacs only breaks lines after whitespace characters. -That produces incorrect results when CJK and Latin text are mixed + Only breaking after whitespace character produces incorrect +results when CJK and Latin text are mixed together (because CJK characters don't use whitespace to separate words). You can customize the option @code{word-wrap-by-category} to allow Emacs to break lines after any character with @samp{|} category @@ -2087,3 +2097,14 @@ argument to suppress the effect of bold-face in this case. byte with a decimal value of 128 is displayed as @code{\200}. To change display to the hexadecimal format of @code{\x80}, set the variable @code{display-raw-bytes-as-hex} to @code{t}. +Care may be needed when interpreting a raw byte when copying +text from a terminal containing an Emacs session, or when a terminal's +@code{escape-glyph} face looks like the default face. For example, by +default Emacs displays the four characters @samp{\}, @samp{2}, +@samp{0}, @samp{0} with the same characters it displays a byte with +decimal value 128. The problem can be worse with hex displays, where +the raw byte 128 followed by the character @samp{7} is displayed as +@code{\x807}, which Emacs Lisp reads as the single character U+0807 +SAMARITAN LETTER IT; this confusion does not occur with the +corresponding octal display @code{\2007} because octal escapes contain +at most three digits. diff --git a/doc/emacs/help.texi b/doc/emacs/help.texi index 1f743ccd88f..11ee9dc2b2f 100644 --- a/doc/emacs/help.texi +++ b/doc/emacs/help.texi @@ -20,10 +20,28 @@ commands (@code{help-for-help}). You can scroll the list with @key{SPC} and @key{DEL}, then type the help command you want. To cancel, type @kbd{C-g}. +@cindex help buffer Many help commands display their information in a special @dfn{help buffer}. In this buffer, you can type @key{SPC} and @key{DEL} to scroll and type @key{RET} to follow hyperlinks. @xref{Help Mode}. +@vindex help-window-select + By default, help commands display the help buffer in a separate +window without selecting that window. The variable +@code{help-window-select} controls this: its default value is +@code{nil}; if it's customized to the value @code{t}, the help window +is unconditionally selected by help commands, and if its value is +@code{other}, the help window is selected only if there are more than +two windows on the selected frame. + +@vindex help-window-keep-selected + Conversely, many commands in the @samp{*Help*} buffer will pop up a +new window to display the results. For instance, clicking on the link +to show the source code, or using the @key{i} command to display the +manual entry, will (by default) pop up a new window. If +@code{help-window-keep-selected} is changed to non-@code{nil}, the +window displaying the @samp{*Help*} buffer will be reused instead. + @cindex searching documentation efficiently @cindex looking for a subject in documentation If you are looking for a certain feature, but don't know what it is @@ -182,7 +200,10 @@ programming language you are editing (@code{info-lookup-symbol}). @item C-h . Display the help message for a special text area, if point is in one (@code{display-local-help}). (These include, for example, links in -@file{*Help*} buffers.) @xref{Help Echo}. +@file{*Help*} buffers.) @xref{Help Echo}. If you invoke +this command with a prefix argument, @kbd{C-u C-h .}, and point is on +a button or a widget, this command will pop a new buffer that +describes that button/widget. @end table @node Key Help @@ -332,9 +353,9 @@ are included varies depending on the command used. @cindex apropos The @dfn{apropos} commands answer questions like, ``What are the -commands for working with files?'' More precisely, you specify an -@dfn{apropos pattern}, which means either a word, a list of words, or -a regular expression. +commands for working with files?'' More precisely, you specify your +query as an @dfn{apropos pattern}, which is either a word, a list of +words, or a regular expression. Each of the following apropos commands reads an apropos pattern in the minibuffer, searches for items that match the pattern, and @@ -393,6 +414,12 @@ comes with a brief description and a list of keys you can currently invoke it with. In our example, it would say that you can invoke @code{find-file} by typing @kbd{C-x C-f}. +@vindex help-window-select@r{, and apropos commands} + By default, the window showing the apropos buffer with the results +of the query is not selected, but you can cause it to be selected by +customizing the variable @code{help-window-select} to any +non-@code{nil} value. + For more information about a function definition, variable or symbol property listed in an apropos buffer, you can click on it with @kbd{mouse-1} or @kbd{mouse-2}, or move there and type @key{RET}. diff --git a/doc/emacs/killing.texi b/doc/emacs/killing.texi index e3de2bc2faf..2fd2d21dd35 100644 --- a/doc/emacs/killing.texi +++ b/doc/emacs/killing.texi @@ -540,11 +540,11 @@ clipboard. clipboard contents are normally lost. Optionally, Emacs can save the existing clipboard contents to the kill ring, preventing you from losing the old clipboard data. If -@code{save-interprogram-paste-before-kill} changed to a number, then -this data is copied over if it's smaller (in characters) than this -number. If this variable is any other non-@code{nil} value, it's -always copied over---at the risk of high memory consumption if that -data turns out to be large. +@code{save-interprogram-paste-before-kill} has been set to a number, +then the data is copied over if it's smaller (in characters) than +this number. If this variable is any other non-@code{nil} value, the +data is always copied over---at the risk of high memory consumption if +that data turns out to be large. Yank commands, such as @kbd{C-y} (@code{yank}), also use the clipboard. If another application ``owns'' the clipboard---i.e., if @@ -567,8 +567,8 @@ change the variable @code{select-enable-clipboard} to @code{nil}. instance, a web browser will usually let you choose ``Copy Image'' on images, and this image will be put on the clipboard. On capable platforms, Emacs can yank these objects with the @code{yank-media} -command---but only in modes that have support for it (@pxref{Yanking -Media,,, elisp, The Emacs Lisp Reference Manual}). +command---but only in modes that have support for it (@w{@pxref{Yanking +Media,,, elisp, The Emacs Lisp Reference Manual}}). @cindex clipboard manager @vindex x-select-enable-clipboard-manager @@ -698,6 +698,9 @@ lines, much like @kbd{mouse-1}. If @code{mouse-yank-at-point} is non-@code{nil}, @kbd{M-mouse-2} yanks at point. Then it does not matter precisely where you click, or even which of the frame's windows you click on. @xref{Mouse Commands}. +This user option also effects interactive search: if it is +non-@code{nil}, yanking with the mouse anywhere in the frame will add +the text to the search string. @node Accumulating Text @section Accumulating Text diff --git a/doc/emacs/macos.texi b/doc/emacs/macos.texi index ab143707fdd..37f48619d12 100644 --- a/doc/emacs/macos.texi +++ b/doc/emacs/macos.texi @@ -273,14 +273,6 @@ application is overriding the default behavior. The modifier keys listed above are defined by macOS and are unaffected by user changes to the modifiers in Emacs. -@item ns-change-font -This event occurs when the user selects a font in a Nextstep font -panel (which can be opened with @kbd{Cmd-t}). The default behavior is -to adjust the font of the selected frame -(@code{ns-respond-to-changefont}). The name and size of the selected -font are stored in the variables @code{ns-input-font} and -@code{ns-input-fontsize}, respectively. - @item ns-power-off This event occurs when the user logs out and Emacs is still running, or when ``Quit Emacs'' is chosen from the application menu. diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi index 37c348d54a9..fc2b2a24e2c 100644 --- a/doc/emacs/maintaining.texi +++ b/doc/emacs/maintaining.texi @@ -1728,6 +1728,7 @@ doesn't seem to belong to a recognizable project, these commands prompt you for the project directory. @findex project-find-file +@vindex vc-directory-exclusion-list The command @kbd{C-x p f} (@code{project-find-file}) is a convenient way of visiting files (@pxref{Visiting}) that belong to the current project. Unlike @kbd{C-x C-f}, this command doesn't require to type @@ -1736,7 +1737,9 @@ base name (i.e., omit the leading directories). In addition, the completion candidates considered by the command include only the files belonging to the current project, and nothing else. If there's a file name at point, this command offers that file as the first element of -the ``future history''. +the ``future history''. If given a prefix, include all files under +the project root, except for @acronym{VCS} directories listed in +@code{vc-directory-exclusion-list}. @findex project-find-regexp The command @kbd{C-x p g} (@code{project-find-regexp}) is similar to @@ -1831,11 +1834,14 @@ buffers as candidates for completion. @findex project-kill-buffers @vindex project-kill-buffer-conditions +@vindex project-kill-buffers-display-buffer-list When you finish working on the project, you may wish to kill all the buffers that belong to the project, to keep your Emacs session smaller. The command @kbd{C-x p k} (@code{project-kill-buffers}) accomplishes that: it kills all the buffers that belong to the current -project that satisfy any of @code{project-kill-buffer-conditions}. +project that satisfy any of @code{project-kill-buffer-conditions}. If +@code{project-kill-buffers-display-buffer-list} is non-@code{nil}, the +buffers to be killed will be displayed first. @node Switching Projects @subsection Switching Projects diff --git a/doc/emacs/mini.texi b/doc/emacs/mini.texi index eeb87972cc3..a899fea7e39 100644 --- a/doc/emacs/mini.texi +++ b/doc/emacs/mini.texi @@ -378,6 +378,20 @@ window. You can display the same list with @kbd{?} used with the completion list: @table @kbd +@vindex minibuffer-completion-auto-choose +@item M-@key{DOWN} +@itemx M-@key{UP} +These keys will navigate through the completions displayed in the +completions buffer. When @code{minibuffer-completion-auto-choose} is +non-@code{nil} (which is the default), using these commands will +automatically insert the current completion candidate in the +minibuffer. If this user option is @code{nil}, the keys will navigate +the same way as before, but won't automatically insert the candidate +in the minibuffer. Instead you have to use the @kbd{M-@key{RET}} command to +do that. With a prefix argument, @kbd{C-u M-@key{RET}} inserts the +currently active candidate to the minibuffer, but doesn't exit the +minibuffer. + @findex switch-to-completions @item M-v @itemx @key{PageUp} @@ -674,6 +688,12 @@ changed by changing the @code{completions-format} user option. If @code{vertical}, sort the completions vertically in columns instead, and if @code{one-column}, just use a single column. +@vindex completions-sort + This user option controls how completions are sorted in the +@samp{*Completions*} buffer. The default is @code{alphabetical}, but +it can also be a function which will be called with the list of +completions, and should return the list in the desired order. + @vindex completions-max-height When @code{completions-max-height} is non-@code{nil}, it limits the size of the completions window. It is specified in lines and include diff --git a/doc/emacs/misc.texi b/doc/emacs/misc.texi index a0d79711f10..9709c6ddc1f 100644 --- a/doc/emacs/misc.texi +++ b/doc/emacs/misc.texi @@ -896,6 +896,19 @@ also rename the @file{*shell*} buffer using @kbd{M-x rename-uniquely}, then create a new @file{*shell*} buffer using plain @kbd{M-x shell}. Subshells in different buffers run independently and in parallel. + Emacs attempts to keep track of what the current directory is by +looking at the commands you enter, looking for @samp{cd} commands and +the like. This is an error-prone solution, since there are many ways +to change the current directory, so Emacs also looks for special +@acronym{OSC} (Operating System Commands) escape codes that are +designed to convey this information in a more reliable fashion. You +should arrange for your shell to print the appropriate escape sequence +at each prompt, for instance with the following command: + +@example +printf "\e]7;file://%s%s\e\\" "$HOSTNAME" "$PWD" +@end example + @vindex explicit-shell-file-name @cindex environment variables for subshells @cindex @env{ESHELL} environment variable diff --git a/doc/emacs/package.texi b/doc/emacs/package.texi index caa65bf33b6..bd3ae2aa6ad 100644 --- a/doc/emacs/package.texi +++ b/doc/emacs/package.texi @@ -320,10 +320,13 @@ version of the package, a newer version is also installed. @section Package Installation @findex package-install +@findex package-update Packages are most conveniently installed using the package menu (@pxref{Package Menu}), but you can also use the command @kbd{M-x package-install}. This prompts for the name of a package with the -@samp{available} status, then downloads and installs it. +@samp{available} status, then downloads and installs it. Similarly, +if you want to update a package, you can use the @kbd{M-x +package-update} command. @cindex package requirements A package may @dfn{require} certain other packages to be installed, diff --git a/doc/emacs/programs.texi b/doc/emacs/programs.texi index ff4405f1fbc..45bc4c79b4f 100644 --- a/doc/emacs/programs.texi +++ b/doc/emacs/programs.texi @@ -250,8 +250,8 @@ where it treats each chapter, section, etc., as a definition. together.) @findex imenu - If you type @kbd{M-x imenu}, it reads the name of a definition using -the minibuffer, then moves point to that definition. You can use + If you type @kbd{M-g i}, it reads the name of a definition using the +minibuffer, then moves point to that definition. You can use completion to specify the name; the command always displays the whole list of valid names. diff --git a/doc/emacs/search.texi b/doc/emacs/search.texi index f2d82324e94..c990f5d766a 100644 --- a/doc/emacs/search.texi +++ b/doc/emacs/search.texi @@ -899,11 +899,13 @@ character folding during incremental regexp search with @kbd{M-s '}, the search becomes a non-regexp search and the search pattern you typed is interpreted as a literal string.) +@cindex pending, in incremental search In some cases, adding characters to the regexp in an incremental regexp search can make the cursor move back and start again. For example, if you have searched for @samp{foo} and you add @samp{\|bar}, the cursor backs up in case the first @samp{bar} precedes the first -@samp{foo}. @xref{Regexps}. +@samp{foo}. (The prompt will change to say ``Pending'' to notify the +user that this recalculation has happened.) @xref{Regexps}. Forward and backward regexp search are not symmetrical, because regexp matching in Emacs always operates forward, starting with the diff --git a/doc/lispintro/emacs-lisp-intro.texi b/doc/lispintro/emacs-lisp-intro.texi index 466d7f0e604..049c8a65a8f 100644 --- a/doc/lispintro/emacs-lisp-intro.texi +++ b/doc/lispintro/emacs-lisp-intro.texi @@ -15345,7 +15345,10 @@ nil @group (20615 27034 579989 697000) (17905 55681 0 0) -(20615 26327 734791 805000) +(20615 26327 734791 805000)@footnote{If @code{current-time-list} is +@code{nil} the three timestamps are @code{(1351051674579989697 +. 1000000000)}, @code{(1173477761000000000 . 1000000000)}, and +@code{(1351050967734791805 . 1000000000)}, respectively.} 13188 "-rw-r--r--" @end group diff --git a/doc/lispref/buffers.texi b/doc/lispref/buffers.texi index 1fe5a60b356..d8cf3d7919b 100644 --- a/doc/lispref/buffers.texi +++ b/doc/lispref/buffers.texi @@ -953,15 +953,59 @@ with a @code{nil} @var{norecord} argument since this may lead to infinite recursion. @end defvar +@defun buffer-match-p condition buffer-or-name &optional arg +This function checks if a buffer designated by @code{buffer-or-name} +satisfies a @code{condition}. Optional third argument @var{arg} is +passed to the predicate function in @var{condition}. A condition can +be one of the following: +@itemize @bullet{} +@item +A string, interpreted as a regular expression. The buffer +satisfies the condition if the regular expression matches the buffer +name. +@item +A predicate function, which should return non-@code{nil} if the buffer +matches. If the function expects one argument, it is called with +@var{buffer-or-name} as the argument; if it expects 2 arguments, the +first argument is @var{buffer-or-name} and the second is @var{arg} +(or @code{nil} if @var{arg} is omitted). +@item +A cons-cell @code{(@var{oper} . @var{expr})} where @var{oper} is one +of +@table @code +@item not +Satisfied if @var{expr} doesn't satisfy @code{buffer-match-p} with +the same buffer and @code{arg}. +@item or +Satisfied if @var{oper} is a list and @emph{any} condition if +@var{expr} satisfies @code{buffer-match-p}, with the same buffer and +@code{arg}. +@item and +Satisfied if @var{oper} is a list and @emph{all} condition if +@var{expr} satisfies @code{buffer-match-p}, with the same buffer and +@code{arg}. +@end table +@end itemize +@end defun + +@defun match-buffers condition &optional buffer-list arg +This function returns a list of all buffers that satisfy a +@code{condition}, as defined for @code{buffer-match-p}. By default +all buffers are considered, but this can be restricted via the second +optional @code{buffer-list} argument. Optional third argument +@var{arg} will be used by @var{condition} in the same way as +@code{buffer-match-p} does. +@end defun + @node Creating Buffers @section Creating Buffers @cindex creating buffers @cindex buffers, creating This section describes the two primitives for creating buffers. -@code{get-buffer-create} creates a buffer if it finds no existing buffer -with the specified name; @code{generate-new-buffer} always creates a new -buffer and gives it a unique name. +@code{get-buffer-create} creates a buffer if it finds no existing +buffer with the specified name; @code{generate-new-buffer} always +creates a new buffer and gives it a unique name. Both functions accept an optional argument @var{inhibit-buffer-hooks}. If it is non-@code{nil}, the buffer they create does not run the hooks diff --git a/doc/lispref/commands.texi b/doc/lispref/commands.texi index ace0c025512..6c60216796c 100644 --- a/doc/lispref/commands.texi +++ b/doc/lispref/commands.texi @@ -312,6 +312,25 @@ If @var{function} is an interactively callable function specifies how to compute its arguments. Otherwise, the value is @code{nil}. If @var{function} is a symbol, its function definition is used. +When called on an OClosure, the work is delegated to the generic +function @code{oclosure-interactive-form}. +@end defun + +@defun oclosure-interactive-form function +Just like @code{interactive-form}, this function takes a command and +returns its interactive form. The difference is that it is a generic +function and it is only called when @var{function} is an OClosure. +The purpose is to make it possible for some OClosure types to compute +their interactive forms dynamically instead of carrying it in one of +their slots. + +This is used for example for @code{kmacro} functions in order to +reduce their memory size, since they all share the same interactive +form. It is also used for @code{advice} functions, where the +interactive form is computed from the interactive forms of its +components, so as to make this computation more lazily and to +correctly adjust the interactive form when one of its component's +is redefined. @end defun @node Interactive Codes diff --git a/doc/lispref/debugging.texi b/doc/lispref/debugging.texi index 469ff2d943d..058c9319544 100644 --- a/doc/lispref/debugging.texi +++ b/doc/lispref/debugging.texi @@ -196,6 +196,17 @@ echo area. For example, this can be useful when trying to find the cause of a particular message. @end defvar +@defvar debug-allow-recursive-debug +You can evaluate forms in the current stack frame in the +@samp{*Backtrace*} buffer with the @key{e} command, and while +edebugging you can use the @key{e} and @key{C-x C-e} commands to do +something similar. By default, the debugger is inhibited by these +commands (because (re-)entering the debugger at this point will +usually take you out of the debugging context you're in). Set +@code{debug-allow-recursive-debug} to a non-@code{nil} value to allow +these commands to enter the debugger recursively. +@end defvar + To debug an error that happens during loading of the init file, use the option @samp{--debug-init}. This binds @code{debug-on-error} to @code{t} while loading the init file, and @@ -387,11 +398,9 @@ possibilities.) variable is temporarily set according to @code{eval-expression-debug-on-error}. If the latter variable is non-@code{nil}, @code{debug-on-error} will temporarily be set to -@code{t}. This means that any further errors that occur while doing a -debugging session will (by default) trigger another backtrace. If -this is not what you want, you can either set -@code{eval-expression-debug-on-error} to @code{nil}, or set -@code{debug-on-error} to @code{nil} in @code{debugger-mode-hook}. +@code{t}. However, further errors that occur while debugging won't +(by default) trigger another debugger, because @code{inhibit-debugger} +will also be bound to non-@code{nil}. The debugger itself must be run byte-compiled, since it makes assumptions about the state of the Lisp interpreter. These @@ -522,6 +531,7 @@ Flag the current frame like @kbd{b}. Then continue execution like @kbd{c}, but temporarily disable break-on-entry for all functions that are set up to do so by @code{debug-on-entry}. +@vindex debug-allow-recursive-debug @item e Read a Lisp expression in the minibuffer, evaluate it (with the relevant lexical environment, if applicable), and print the @@ -530,7 +540,11 @@ variables, and the current buffer, as part of its operation; @kbd{e} temporarily restores their values from outside the debugger, so you can examine and change them. This makes the debugger more transparent. By contrast, @kbd{M-:} does nothing special in the debugger; it shows you -the variable values within the debugger. +the variable values within the debugger. By default, this command +suppresses the debugger during evaluation, so that an error in the +evaluated expression won't add a new error on top of the existing one. +Set the @code{debug-allow-recursive-debug} user option to a +non-@code{nil} value to override this. @item R Like @kbd{e}, but also save the result of evaluation in the diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index 2dc0ef4c0ba..390d1650253 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -336,7 +336,10 @@ functions call it with no arguments when their argument message is Usually this function is called when the next input event arrives after displaying an echo-area message. The function is expected to clear the message displayed by its counterpart function specified by -@code{set-message-function}. +@code{set-message-function}, but doesn't have to. If the function +wants the echo area to remain uncleared, it should return the symbol +@code{dont-clear-message}; any other value will result in the echo +area being cleared. The default value is the function that clears the message displayed in an active minibuffer. @@ -2142,7 +2145,7 @@ the buffer might contain long lines that will be truncated anyway. The optional argument @var{y-limit}, if non-@code{nil}, specifies the maximum Y coordinate beyond which text is to be ignored; it is therefore also the maximum pixel-height that the function can return. -If @var{y-limit} is nil or omitted, it means to considers all the +If @var{y-limit} is @code{nil} or omitted, it means to consider all the lines of text till the buffer position specified by @var{to}. Since calculating the pixel-height of a large buffer can take some time, it makes sense to specify this argument; in particular, if the caller @@ -2249,6 +2252,20 @@ This is a convenience function that uses @code{window-text-pixel-size} to compute the width of @var{string} (in pixels). @end defun +@defun window-char-pixel-width &optional window face +Return the average character width for the font used by @var{face} in +@var{window}. If @var{face} is @code{nil} or omitted, the +@code{default} face is used. If @var{windows} is @code{nil} or +omitted, the currently selected window is used. +@end defun + +@defun window-char-pixel-height &optional window face +Return the average character height for the font used by @var{face} in +@var{window}. If @var{face} is @code{nil} or omitted, the +@code{default} face is used. If @var{windows} is @code{nil} or +omitted, the currently selected window is used. +@end defun + @defun line-pixel-height This function returns the height in pixels of the line at point in the selected window. The value includes the line spacing of the line @@ -2924,7 +2941,8 @@ modifying the attributes of a named face. @defun face-attribute face attribute &optional frame inherit This function returns the value of the @var{attribute} attribute for -@var{face} on @var{frame}. +@var{face} on @var{frame}. @xref{Face Attributes}, for the supported +attributes. If @var{frame} is omitted or @code{nil}, that means the selected frame (@pxref{Input Focus}). If @var{frame} is @code{t}, this function @@ -3007,7 +3025,8 @@ for all frames. This function is mostly intended for internal usage. @defun set-face-attribute face frame &rest arguments This function sets one or more attributes of @var{face} for @var{frame}. The attributes specified in this way override the face -spec(s) belonging to @var{face}. +spec(s) belonging to @var{face}. @xref{Face Attributes}, for the +supported attributes. The extra arguments @var{arguments} specify the attributes to set, and the values for them. They should consist of alternating attribute @@ -3807,57 +3826,62 @@ Then, the font specifications for all but Chinese GB2312 characters have Chinese GB2312 characters has a wild card @samp{*} in the @var{family} field. -@defun set-fontset-font name character font-spec &optional frame add -This function modifies the existing fontset @var{name} to use the font -matching with @var{font-spec} for the specified @var{character}. +@defun set-fontset-font fontset characters font-spec &optional frame add +This function modifies the existing @var{fontset} to use the font +specified by @var{font-spec} for displaying the specified +@var{characters}. -If @var{name} is @code{nil}, this function modifies the fontset of the -selected frame or that of @var{frame} if @var{frame} is not +If @var{fontset} is @code{nil}, this function modifies the fontset of +the selected frame or that of @var{frame} if @var{frame} is not @code{nil}. -If @var{name} is @code{t}, this function modifies the default -fontset, whose short name is @samp{fontset-default}. +If @var{fontset} is @code{t}, this function modifies the default +fontset, whose short name as a string is @samp{fontset-default}. -In addition to specifying a single codepoint, @var{character} may be a -cons @code{(@var{from} . @var{to})}, where @var{from} and @var{to} are -character codepoints. In that case, use @var{font-spec} for all the -characters in the range @var{from} and @var{to} (inclusive). +The @var{characters} argument can be a single character which should +be displayed using @var{font-spec}. It can also be a cons cell +@w{@code{(@var{from} . @var{to})}}, where @var{from} and @var{to} are +characters. In that case, use @var{font-spec} for all the characters +in the range @var{from} and @var{to} (inclusive). -@var{character} may be a charset (@pxref{Character Sets}). In that -case, use @var{font-spec} for all the characters in the charset. +@var{characters} may be a charset symbol (@pxref{Character Sets}). In +that case, use @var{font-spec} for all the characters in the charset. -@var{character} may be a script name (@pxref{Character Properties, +@var{characters} may be a script symbol (@pxref{Character Properties, char-script-table}). In that case, use @var{font-spec} for all the characters belonging to the script. -@var{character} may be @code{nil}, which means to use @var{font-spec} -for any character which no font-spec is specified. +@var{characters} may be @code{nil}, which means to use @var{font-spec} +for any character in @var{fontset} for which no font-spec is +specified. @var{font-spec} may be a font-spec object created by the function @code{font-spec} (@pxref{Low-Level Font}). -@var{font-spec} may be a cons; @code{(@var{family} . @var{registry})}, -where @var{family} is a family name of a font (possibly including a -foundry name at the head), @var{registry} is a registry name of a font -(possibly including an encoding name at the tail). +@var{font-spec} may be a cons cell @w{@code{(@var{family} +. @var{registry})}}, where @var{family} is a family name of a font +(possibly including a foundry name at the head), and @var{registry} is +a registry name of a font (possibly including an encoding name at the +tail). @var{font-spec} may be a font name, a string. @var{font-spec} may be @code{nil}, which explicitly specifies that -there's no font for the specified @var{character}. This is useful, +there's no font for the specified @var{characters}. This is useful, for example, to avoid expensive system-wide search for fonts for characters that have no glyphs, like those from the Unicode Private Use Area (PUA). The optional argument @var{add}, if non-@code{nil}, specifies how to -add @var{font-spec} to the font specifications previously set. If it -is @code{prepend}, @var{font-spec} is prepended. If it is -@code{append}, @var{font-spec} is appended. By default, -@var{font-spec} overrides the previous settings. +add @var{font-spec} to the font specifications previously set for +@var{characters}. If it is @code{prepend}, @var{font-spec} is +prepended to the existing specs. If it is @code{append}, +@var{font-spec} is appended. By default, @var{font-spec} overwrites +the previously set font specs. -For instance, this changes the default fontset to use a font of which +For instance, this changes the default fontset to use a font whose family name is @samp{Kochi Gothic} for all characters belonging to -the charset @code{japanese-jisx0208}. +the charset @code{japanese-jisx0208}: @smallexample (set-fontset-font t 'japanese-jisx0208 @@ -3998,12 +4022,22 @@ symbols, or @code{nil} if none is required. If @code{gsub} or @code{gpos} is a list, a @code{nil} element in that list means that the font must not match any of the remaining tag symbols. The @code{gpos} element may be omitted. + +@item :type +@cindex font backend +The symbol that specifies the @dfn{font backend} used to draw the +characters. The possible values depend on the platform and on how +Emacs was configured at build time. Typical values include +@code{ftcrhb} and @code{xfthb} on X, @code{harfbuzz} on MS-Windows, +@code{ns} on GNUstep, etc. It can also be @code{nil} if left +unspecified, typically in a font-spec. @end table @end defun @defun font-put font-spec property value Set the font property @var{property} in the font-spec @var{font-spec} -to @var{value}. +to @var{value}. The @var{property} can any of the ones described +above. @end defun @cindex font entity @@ -4047,12 +4081,28 @@ object, a font entity, or a font spec. @defun font-get font property This function returns the value of the font property @var{property} -for @var{font}. +for @var{font}. The @var{property} can any of the ones that +@code{font-spec} supports. If @var{font} is a font spec and the font spec does not specify @var{property}, the return value is @code{nil}. If @var{font} is a font object or font entity, the value for the @var{:script} property -may be a list of scripts supported by the font. +may be a list of scripts supported by the font, and the value of the +@code{:otf} property is a cons of the form @w{@code{(@var{gsub} +. @var{gpos})}}, where @var{gsub} and @var{gpos} are lists +representing OpenType features supported by the font, of the form + +@smallexample +((@var{script-tag} (@var{langsys-tag} @var{feature}@dots{}) @dots{}) @dots{}) +@end smallexample + +@noindent where @var{script-tag}, @var{langsys-tag}, and @var{feature} +are symbols representing OpenType layout tags. + +If @var{font} is a font object, the special property +@code{:combining-capability} is non-@code{nil} if the font backend of +@var{font} supports rendering of combining characters for non-OpenType +fonts. @end defun @defun font-face-attributes font &optional frame @@ -7517,7 +7567,7 @@ end of the buffer continues from the other end. If @var{display-message} is non-@code{nil}, the button's help-echo string is displayed. Any button with a non-@code{nil} @code{skip} property is skipped over. Returns the button found, and signals an error if no -buttons can be found. If @var{no-error} is non-@code{nil}, return nil +buttons can be found. If @var{no-error} is non-@code{nil}, return @code{nil} instead of signaling the error. @end deffn @@ -7529,7 +7579,7 @@ end of the buffer continues from the other end. If @var{display-message} is non-@code{nil}, the button's help-echo string is displayed. Any button with a non-@code{nil} @code{skip} property is skipped over. Returns the button found, and signals an error if no -buttons can be found. If @var{no-error} is non-@code{nil}, return nil +buttons can be found. If @var{no-error} is non-@code{nil}, return @code{nil} instead of signaling the error. @end deffn @@ -8281,7 +8331,7 @@ there is no available font (on a graphical display), and characters which cannot be encoded by the terminal's coding system (on a text terminal). -@vindex glyphless-display-mode +@findex glyphless-display-mode The @code{glyphless-display-mode} minor mode can be used to toggle displaying glyphless characters in a convenient manner in the current buffer. If this mode is enabled, all the glyphless characters are diff --git a/doc/lispref/edebug.texi b/doc/lispref/edebug.texi index eff9621628e..0fc5271d5ad 100644 --- a/doc/lispref/edebug.texi +++ b/doc/lispref/edebug.texi @@ -700,8 +700,12 @@ on this process. @table @kbd @item e @var{exp} @key{RET} Evaluate expression @var{exp} in the context outside of Edebug -(@code{edebug-eval-expression}). That is, Edebug tries to minimize its -interference with the evaluation. +(@code{edebug-eval-expression}). That is, Edebug tries to minimize +its interference with the evaluation. By default, this command +suppresses the debugger during evaluation, so that an error in the +evaluated expression won't add a new error on top of the existing one. +Set the @code{debug-allow-recursive-debug} user option to a +non-@code{nil} value to override this. @item M-: @var{exp} @key{RET} Evaluate expression @var{exp} in the context of Edebug itself diff --git a/doc/lispref/files.texi b/doc/lispref/files.texi index d8b55b114ae..75905658e64 100644 --- a/doc/lispref/files.texi +++ b/doc/lispref/files.texi @@ -1450,13 +1450,19 @@ is owned by the user with name @samp{lh}. is in the group with name @samp{users}. @item (20614 64019 50040 152000) -was last accessed on October 23, 2012, at 20:12:03.050040152 UTC. +was last accessed on October 23, 2012, at 20:12:03.050040152 UTC@. +(This timestamp is @code{(1351023123050040152 . 1000000000)} +if @code{current-time-list} is @code{nil}.) @item (20000 23 0 0) -was last modified on July 15, 2001, at 08:53:43 UTC. +was last modified on July 15, 2001, at 08:53:43.000000000 UTC@. +(This timestamp is @code{(1310720023000000000 . 1000000000)} +if @code{current-time-list} is @code{nil}.) @item (20614 64555 902289 872000) -last had its status changed on October 23, 2012, at 20:20:59.902289872 UTC. +last had its status changed on October 23, 2012, at 20:20:59.902289872 UTC@. +(This timestamp is @code{(1351023659902289872 . 1000000000)} +if @code{current-time-list} is @code{nil}.) @item 122295 is 122295 bytes long. (It may not contain 122295 characters, though, diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi index 70337d4c4a8..2f386eaa47e 100644 --- a/doc/lispref/functions.texi +++ b/doc/lispref/functions.texi @@ -1616,7 +1616,7 @@ were a local variable that had been captured by static scoping. @defun oclosure-type object This function returns the OClosure type (a symbol) of @var{object} if it is an -OClosure, and nil otherwise. +OClosure, and @code{nil} otherwise. @end defun diff --git a/doc/lispref/intro.texi b/doc/lispref/intro.texi index 5afd2f4ecf2..975215d6976 100644 --- a/doc/lispref/intro.texi +++ b/doc/lispref/intro.texi @@ -503,9 +503,11 @@ if the information is not available. @example @group emacs-build-time - @result{} (20614 63694 515336 438000) + @result{} (25194 55894 8547 617000) @end group @end example +(This timestamp is @code{(1651169878008547617 . 1000000000)} +if @code{current-time-list} was @code{nil} when Emacs was built.) @end defvar @defvar emacs-version diff --git a/doc/lispref/keymaps.texi b/doc/lispref/keymaps.texi index 9d3dc8fe420..a037c228f13 100644 --- a/doc/lispref/keymaps.texi +++ b/doc/lispref/keymaps.texi @@ -1643,7 +1643,7 @@ non-@code{nil}, the definition will be removed. This is almost the same as setting the definition to @code{nil}, but makes a difference if the @var{keymap} has a parent, and @var{key} is shadowing the same binding in the parent. With @var{remove}, subsequent lookups will -return the binding in the parent, and with a nil @var{def}, the +return the binding in the parent, whereas with a @code{nil} definition the lookups will return @code{nil}. @end defun diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi index f05f087ba70..be81b5b3fbb 100644 --- a/doc/lispref/minibuf.texi +++ b/doc/lispref/minibuf.texi @@ -244,6 +244,13 @@ This function works by calling the value)) @end group @end smallexample + +@findex read-string-from-buffer +If you have a long string (for instance, one that is several lines +long) that you wish to edit, using @code{read-string} may not be +ideal. In that case, popping to a new, normal buffer where the user +can edit the string may be more convenient, and you can use the +@code{read-string-from-buffer} function to do that. @end defun @defun read-regexp prompt &optional defaults history @@ -1936,6 +1943,7 @@ completion function is trying to complete. If the symbol matches one of the keys in @code{completion-category-overrides}, the usual completion behavior is overridden. @xref{Completion Variables}. +@cindex @code{annotation-function}, in completion @item annotation-function The value should be a function for @dfn{annotating} completions. The function should take one argument, @var{string}, which is a possible @@ -1945,6 +1953,7 @@ Unless this function puts own face on the annotation suffix string, the @code{completions-annotations} face is added by default to that string. +@cindex @code{affixation-function}, in completion @item affixation-function The value should be a function for adding prefixes and suffixes to completions. The function should take one argument, @@ -1955,6 +1964,7 @@ the completion string in the @file{*Completions*} buffer, and a suffix displayed after the completion string. This function takes priority over @code{annotation-function}. +@cindex @code{group-function}, in completion @item group-function The value should be a function for grouping the completion candidates. The function must take two arguments, @var{completion}, which is a @@ -1965,12 +1975,14 @@ can also be @code{nil}. Otherwise the function must return the transformed candidate. The transformation can for example remove a redundant prefix, which is displayed in the group title. +@cindex @code{display-sort-function}, in completion @item display-sort-function The value should be a function for sorting completions. The function should take one argument, a list of completion strings, and return a sorted list of completion strings. It is allowed to alter the input list destructively. +@cindex @code{cycle-sort-function}, in completion @item cycle-sort-function The value should be a function for sorting completions, when @code{completion-cycle-threshold} is non-@code{nil} and the user is diff --git a/doc/lispref/os.texi b/doc/lispref/os.texi index 9cb9bc75d04..9df708532d8 100644 --- a/doc/lispref/os.texi +++ b/doc/lispref/os.texi @@ -699,7 +699,7 @@ If you started Emacs from a terminal, the parent process normally resumes control. The low-level primitive for killing Emacs is @code{kill-emacs}. -@deffn Command kill-emacs &optional exit-data +@deffn Command kill-emacs &optional exit-data restart This command calls the hook @code{kill-emacs-hook}, then exits the Emacs process and kills it. @@ -714,6 +714,10 @@ input) can read them. If @var{exit-data} is neither an integer nor a string, or is omitted, that means to use the (system-specific) exit status which indicates successful program termination. + +If @var{restart} is non-@code{nil}, instead of just exiting at the +end, start a new Emacs process, using the same command line arguments +as the currently running Emacs process. @end deffn @cindex SIGTERM @@ -756,6 +760,13 @@ the remaining functions in this hook. Calling @code{kill-emacs} directly does not run this hook. @end defopt +@deffn Command restart-emacs +This command does the same as @code{save-buffers-kill-emacs}, but +instead of just killing the current Emacs process at the end, it'll +restart a new Emacs process, using the same command line arguments as +the currently running Emacs process. +@end deffn + @node Suspending Emacs @subsection Suspending Emacs @cindex suspending Emacs @@ -1303,10 +1314,16 @@ zone. @cindex Lisp timestamp @cindex timestamp, Lisp +@cindex Coordinated Universal Time +@cindex Universal Time +@cindex UTC +@cindex leap seconds Many functions like @code{current-time} and @code{file-attributes} return @dfn{Lisp timestamp} values that count seconds, and that can represent absolute time by counting seconds since the @dfn{epoch} of -1970-01-01 00:00:00 UTC. +1970-01-01 00:00:00 UTC (Coordinated Universal Time). Typically these +counts ignore leap seconds; however, GNU and some other operating +systems can be configured to count leap seconds. Although traditionally Lisp timestamps were integer pairs, their form has evolved and programs ordinarily should not depend on the @@ -1328,11 +1345,7 @@ A pair of integers @code{(@var{ticks} . @var{hz})}, where @var{hz} is positive. This represents @var{ticks}/@var{hz} seconds, which is the same time as plain @var{ticks} if @var{hz} is 1. A common value for @var{hz} is 1000000000, for a nanosecond-resolution -clock.@footnote{Currently @var{hz} should be at least 65536 to avoid -compatibility warnings when the timestamp is passed to standard -functions, as previous versions of Emacs would interpret such a -timestamps differently due to backward-compatibility concerns. These -warnings are intended to be removed in a future Emacs version.} +clock. @item A list of four integers @code{(@var{high} @var{low} @var{micro} @@ -1346,7 +1359,8 @@ This represents the number of seconds using the formula: @tex $high \times 2^{16} + low + micro \times 10^{-6} + pico \times 10^{-12}$. @end tex -In some cases, functions may default to returning two- or +If @code{current-time-list} is @code{t}, +some functions may default to returning two- or three-element lists, with omitted @var{micro} and @var{pico} components defaulting to zero. On all current machines @var{pico} is a multiple of 1000, but this @@ -1357,7 +1371,7 @@ may change as higher-resolution clocks become available. Function arguments, e.g., the @var{time} argument to @code{format-time-string}, accept a more-general @dfn{time value} format, which can be a Lisp timestamp, @code{nil} for the current -time, a single floating-point number for seconds, or a list +time, a finite floating-point number for seconds, or a list @code{(@var{high} @var{low} @var{micro})} or @code{(@var{high} @var{low})} that is a truncated list timestamp with missing elements taken to be zero. @@ -1367,8 +1381,8 @@ Time values can be converted to and from calendrical and other forms. Some of these conversions rely on operating system functions that limit the range of possible time values, and signal an error such as @samp{"Specified time is not representable"} if the -limits are exceeded. For instance, a system may not support years -before 1970, or years before 1901, or years far in the future. +limits are exceeded. For instance, a system might not support +timestamps before the epoch, or years far in the future. You can convert a time value into a human-readable string using @code{format-time-string}, into a Lisp timestamp using @code{time-convert}, and into other forms using @@ -1400,13 +1414,28 @@ The operating system limits the range of time and zone values. @end example @end defun +@defvar current-time-list +This boolean variable is a transition aid. If @code{t}, +@code{current-time} and related functions return timestamps in list +form, typically @code{(@var{high} @var{low} @var{micro} @var{pico})}; +otherwise, they use @code{(@var{ticks} . @var{hz})} form. Currently +this variable defaults to @code{t}, for behavior compatible with +previous Emacs versions. Developers are encouraged to test +timestamp-related code with this variable set to @code{nil}, as it +will default to @code{nil} in a future Emacs version, and will be +removed in some version after that. +@end defvar + @defun current-time This function returns the current time as a Lisp timestamp. -Although the timestamp takes the form @code{(@var{high} @var{low} -@var{micro} @var{pico})} in the current Emacs release, this is -planned to change in a future Emacs version. You can use the -@code{time-convert} function to convert a timestamp to some other -form. @xref{Time Conversion}. +If @code{current-time-list} is @code{nil}, +the timestamp has the form @code{(@var{ticks} . @var{hz})} where +@var{ticks} counts clock ticks and @var{hz} is the clock ticks per second. +Otherwise, the timestamp has the list form +@code{(@var{high} @var{low} @var{usec} @var{psec})}. +You can use @code{(time-convert nil t)} or @code{(time-convert nil 'list)} +to obtain a particular form regardless of the value of +@code{current-time-list}. @xref{Time Conversion}. @end defun @defun float-time &optional time @@ -1422,6 +1451,13 @@ as @samp{0.1} but is slightly greater than 1/10. @code{time-to-seconds} is an alias for this function. @end defun +@defun current-cpu-time +Return the current @acronym{CPU} time along with its resolution. The +return value is a pair @code{(CPU-TICKS . TICKS-PER-SEC)}. The +@var{CPU-TICKS} counter can wrap around, so values cannot be +meaningfully compared if too much time has passed between them. +@end defun + @node Time Zone Rules @section Time Zone Rules @cindex time zone rules @@ -1434,11 +1470,11 @@ to default to Universal Time with @code{(setenv "TZ" "UTC0")}. If which is a platform-dependent default time zone. The set of supported @env{TZ} strings is system-dependent. GNU and -many other systems support the tzdata database, e.g., +many other systems support TZDB timezones, e.g., @samp{"America/New_York"} specifies the time zone and daylight saving time history for locations near New York City. GNU and most other systems support POSIX-style @env{TZ} strings, e.g., -@samp{"EST+5EDT,M4.1.0/2,M10.5.0/2"} specifies the rules used in New +@samp{"EST5EDT,M4.1.0,M10.5.0"} specifies the rules used in New York from 1987 through 2006. All systems support the string @samp{"UTC0"} meaning Universal Time. @@ -1490,18 +1526,20 @@ The operating system limits the range of time and zone values. These functions convert time values (@pxref{Time of Day}) to Lisp timestamps, or into calendrical information and vice versa. - Many 32-bit operating systems are limited to system times containing -32 bits of information in their seconds component; these systems -typically handle only the times from 1901-12-13 20:45:52 through -2038-01-19 03:14:07 Universal Time. However, 64-bit and some 32-bit operating -systems have larger seconds components, and can represent times far in -the past or future. - - Calendrical conversion functions always use the Gregorian calendar, even -for dates before the Gregorian calendar was introduced. Year numbers -count the number of years since the year 1 BC, and do not skip zero + Many operating systems use 64-bit signed integers to count seconds, +and can represent times far in the past or future. However, some are +more limited. For example, old-fashioned operating systems that use +32-bit signed integers typically handle only times from 1901-12-13 +20:45:52 through 2038-01-19 03:14:07 Universal Time. + + Calendrical conversion functions use the Gregorian calendar even for +dates before the Gregorian calendar was introduced, and for dates in +the far distant past or future for which the Gregorian calendar +is wildly inaccurate and disagrees with common practice in scientific fields +like astronomy and paleontology, which use Julian-calendar year lengths. +Year numbers count since the year 1 BCE, and do not skip zero as traditional Gregorian years do; for example, the year number -@minus{}37 represents the Gregorian year 38 BC@. +@minus{}37 represents the Gregorian year 38 BCE@. @defun time-convert time &optional form This function converts a time value into a Lisp timestamp. @@ -1513,20 +1551,20 @@ integer, it specifies a clock frequency and this function returns an integer-pair timestamp @code{(@var{ticks} . @var{form})}. If @var{form} is @code{t}, this function treats it as a positive integer suitable for representing the timestamp; for example, it is treated as 1000000000 -if @var{time} is nil and the platform timestamp has nanosecond +if @var{time} is @code{nil} and the platform timestamp has nanosecond resolution. If @var{form} is @code{list}, this function returns an integer list @code{(@var{high} @var{low} @var{micro} @var{pico})}. Although an omitted or @code{nil} @var{form} currently acts like @code{list}, this is planned to change in a future Emacs version, so callers requiring list timestamps should pass @code{list} explicitly. -If @var{time} is infinite or a NaN, this function signals an error. +If @var{time} is not a time value, this function signals an error. Otherwise, if @var{time} cannot be represented exactly, conversion truncates it toward minus infinity. When @var{form} is @code{t}, conversion is always exact so no truncation occurs, and the returned clock resolution is no less than that of @var{time}. By way of -contrast, @code{float-time} can convert any Lisp time value without -signaling an error, although the result might not be exact. +contrast, although @code{float-time} can also convert any time value +without signaling an error, the result might not be exact. @xref{Time of Day}. For efficiency this function might return a value that is @code{eq} to @@ -1614,59 +1652,12 @@ a particular form should specify @var{form}. @var{dow} and @var{utcoff}, and its @var{second} is an integer between 0 and 59 inclusive. -To access (or alter) the elements in the time value, the +To access (or alter) the elements in the calendrical information, the @code{decoded-time-second}, @code{decoded-time-minute}, @code{decoded-time-hour}, @code{decoded-time-day}, @code{decoded-time-month}, @code{decoded-time-year}, @code{decoded-time-weekday}, @code{decoded-time-dst} and @code{decoded-time-zone} accessors can be used. - -For instance, to increase the year in a decoded time, you could say: - -@lisp -(setf (decoded-time-year decoded-time) - (+ (decoded-time-year decoded-time) 4)) -@end lisp - -Also see the following function. - -@end defun - -@defun decoded-time-add time delta -This function takes a decoded time structure and adds @var{delta} -(also a decoded time structure) to it. Elements in @var{delta} that -are @code{nil} are ignored. - -For instance, if you want ``same time next month'', you -could say: - -@lisp -(let ((time (decode-time nil nil t)) - (delta (make-decoded-time :month 2))) - (encode-time (decoded-time-add time delta))) -@end lisp - -If this date doesn't exist (if you're running this on January 31st, -for instance), then the date will be shifted back until you get a -valid date (which will be February 28th or 29th, depending). - -Fields are added in a most to least significant order, so if the -adjustment described above happens, it happens before adding days, -hours, minutes or seconds. - -The values in @var{delta} can be negative to subtract values instead. - -The return value is a decoded time structure. -@end defun - -@defun make-decoded-time &key second minute hour day month year dst zone -Return a decoded time structure with only the given keywords filled -out, leaving the rest @code{nil}. For instance, to get a structure -that represents ``two months'', you could say: - -@lisp -(make-decoded-time :month 2) -@end lisp @end defun @defun encode-time time &rest obsolescent-arguments @@ -1676,9 +1667,26 @@ It can act as the inverse of @code{decode-time}. Ordinarily the first argument is a list @code{(@var{second} @var{minute} @var{hour} @var{day} @var{month} @var{year} @var{ignored} @var{dst} @var{zone})} that specifies a -decoded time in the style of @code{decode-time}, so that -@code{(encode-time (decode-time ...))} works. For the meanings of -these list members, see the table under @code{decode-time}. +decoded time in the style of @code{decode-time}. For the meanings of +these list elements, see the table under @code{decode-time}. +In particular, @var{dst} says how to interpret timestamps during a +daylight saving fallback when timestamps are repeated. +If @var{dst} is @minus{}1, the DST value is guessed; if it +is @code{t} or @code{nil} the timestamp with that DST value +is returned, with an error signaled if no such timestamp exists. +Unfortunately a @var{dst} value of @code{t} or @code{nil} does not +disambiguate timestamps duplicated when a TZDB-based timezone moves +further west of Greenwich, such as disambiguating the two +standard-time timestamps 2020-12-27 01:30 when @var{zone} is +@samp{"Europe/Volgograd"}, which at 02:00 that day changed +standard time from 4 to 3 hours east of Greenwich; if you need to +handle situations like this you can use a numeric @var{zone} to +disambiguate instead. + +The first argument can also be a list @code{(@var{second} @var{minute} +@var{hour} @var{day} @var{month} @var{year})}, which is treated like +the list @code{(@var{second} @var{minute} @var{hour} @var{day} +@var{month} @var{year} nil -1 nil)}. As an obsolescent calling convention, this function can be given six or more arguments. The first six arguments @var{second}, @@ -1687,14 +1695,18 @@ specify most of the components of a decoded time. If there are more than six arguments the @emph{last} argument is used as @var{zone} and any other extra arguments are ignored, so that @code{(apply #'encode-time (decode-time ...))} works. In this obsolescent -convention, @var{zone} defaults to the current time zone rule -(@pxref{Time Zone Rules}), and @var{dst} is treated as if it was -@minus{}1. +convention, @var{dst} is @minus{}1 and @var{zone} defaults to the +current time zone rule (@pxref{Time Zone Rules}). +When modernizing an obsolescent caller, ensure that the more-modern +list equivalent contains 9 elements with a @code{dst} element that +is @minus{}1, not @code{nil}. Year numbers less than 100 are not treated specially. If you want them to stand for years above 1900, or years above 2000, you must alter them yourself before you call @code{encode-time}. The operating system limits the range of time and zone values. +However, timestamps ranging from the epoch to the near future are +always supported. The @code{encode-time} function acts as a rough inverse to @code{decode-time}. For example, you can pass the output of @@ -1707,6 +1719,33 @@ the latter to the former as follows: You can perform simple date arithmetic by using out-of-range values for @var{seconds}, @var{minutes}, @var{hour}, @var{day}, and @var{month}; for example, day 0 means the day preceding the given month. +Take care when doing so, as it is common for this to fail in some cases. +For example: + +@lisp +;; Try to compute the time one month from now. +;; Watch out; this might not work as expected. +(let ((time (decode-time))) + (setf (decoded-time-month time) + (+ (decoded-time-month time) 1)) + time) +@end lisp + +@noindent +Unfortunately, this code might not work as expected if the resulting +time is invalid due to month length differences, +daylight saving transitions, time zone changes, +or missing leap days or leap seconds. For example, if executed on +January 30 this code yields a nonexistent date February 30, +which @code{encode-time} would adjust to early March. +Similarly, adding four years to February 29, 2096 would yield the +nonexistent date February 29, 2100; and adding one hour to 01:30 on +March 13, 2022 in New York would yield a timestamp 02:30 that does not +exist because clocks sprang forward from 02:00 to 03:00 that day. +To avoid some (though not all) of the problem, you +can base calculations on the middle of the affected unit, e.g., start +at the 15th of the month when adding months. Alternatively, you can use the +@file{calendar} and @file{time-date} libraries. @end defun @node Time Parsing @@ -1716,7 +1755,7 @@ for example, day 0 means the day preceding the given month. @cindex formatting time values These functions convert time values to text in a string, and vice versa. -Time values include @code{nil}, numbers, and Lisp timestamps +Time values include @code{nil}, finite numbers, and Lisp timestamps (@pxref{Time of Day}). @defun date-to-time string @@ -1961,6 +2000,10 @@ encountered. For example, the default format used by @w{@code{"%Y, %D, %H, %M, %z%S"}} means that the number of seconds will always be produced, but years, days, hours, and minutes will only be shown if they are non-zero. +@item %x +Non-printing control flag that works along the same lines as +@samp{%z}, but instead suppresses printing of trailing zero-value time +elements. @item %% Produces a literal @samp{%}. @end table @@ -2024,25 +2067,23 @@ interactively, it prints the duration in the echo area. These functions perform calendrical computations using time values (@pxref{Time of Day}). As with any time value, a value of @code{nil} for any of their -time-value arguments stands for the current system time, and a single +time-value arguments stands for the current system time, and a finite number stands for the number of seconds since the epoch. @defun time-less-p t1 t2 -This returns @code{t} if time value @var{t1} is less than time value +This returns @code{t} if the time value @var{t1} is less than the time value @var{t2}. -The result is @code{nil} if either argument is a NaN. @end defun @defun time-equal-p t1 t2 -This returns @code{t} if @var{t1} and @var{t2} are equal time values. -The result is @code{nil} if either argument is a NaN. +This returns @code{t} if the two time values @var{t1} and @var{t2} are +equal. @end defun @defun time-subtract t1 t2 This returns the time difference @var{t1} @minus{} @var{t2} between -two time values, as a Lisp time value. The result is exact and its clock +two time values, as a Lisp timestamp. The result is exact and its clock resolution is no worse than the worse of its two arguments' resolutions. -The result is floating-point only if it is infinite or a NaN@. If you need the difference in units of elapsed seconds, you can convert it with @code{time-convert} or @code{float-time}. @xref{Time Conversion}. @@ -2294,7 +2335,8 @@ can use in calling @code{cancel-timer} (@pxref{Timers}). @end deffn @cindex idleness - Emacs becomes @dfn{idle} when it starts waiting for user input, and + Emacs becomes @dfn{idle} when it starts waiting for user input +(unless it waits for input with a timeout, @pxref{Reading One Event}), and it remains idle until the user provides some input. If a timer is set for five seconds of idleness, it runs approximately five seconds after Emacs first becomes idle. Even if @var{repeat} is non-@code{nil}, @@ -3097,21 +3139,21 @@ This function removes the tray notification given by its unique @cindex watch, for filesystem events Several operating systems support watching of filesystems for changes -of files. If configured properly, Emacs links a respective library -like @file{inotify}, @file{kqueue}, @file{gfilenotify}, or -@file{w32notify} statically. These libraries enable watching of -filesystems on the local machine. +to files or their attributes. If configured properly, Emacs links a +respective library like @file{inotify}, @file{kqueue}, +@file{gfilenotify}, or @file{w32notify} statically. These libraries +enable watching of filesystems on the local machine. It is also possible to watch filesystems on remote machines, -@pxref{Remote Files,, Remote Files, emacs, The GNU Emacs Manual} +@pxref{Remote Files,, Remote Files, emacs, The GNU Emacs Manual}. This does not depend on one of the libraries linked to Emacs. -Since all these libraries emit different events on notified file -changes, there is the Emacs library @code{filenotify} which provides a -unified interface. Lisp programs that want to receive file -notifications should always use this library in preference to the -native ones. - +Since all these libraries emit different events upon notified file +changes, Emacs provides a special library @code{filenotify} which +presents a unified interface to applications. Lisp programs that want +to receive file notifications should always use this library in +preference to the native ones. This section documents the +@code{filenotify} library functions and variables. @defun file-notify-add-watch file flags callback Add a watch for filesystem events pertaining to @var{file}. This @@ -3119,31 +3161,33 @@ arranges for filesystem events pertaining to @var{file} to be reported to Emacs. The returned value is a descriptor for the added watch. Its type -depends on the underlying library, it cannot be assumed to be an -integer as in the example below. It should be used for comparison by -@code{equal} only. +depends on the underlying library, and in general cannot be assumed to +be an integer as in the example below. It should be used for +comparison by @code{equal} only. If the @var{file} cannot be watched for some reason, this function signals a @code{file-notify-error} error. Sometimes, mounted filesystems cannot be watched for file changes. -This is not detected by this function, a non-@code{nil} return value -does not guarantee that changes on @var{file} will be notified. +This is not detected by this function, and so a non-@code{nil} return +value does not guarantee that changes on @var{file} will be actually +notified. @var{flags} is a list of conditions to set what will be watched for. It can include the following symbols: @table @code @item change -watch for file changes +watch for changes in file's contents @item attribute-change -watch for file attribute changes, like permissions or modification +watch for changes in file attributes, like permissions or modification time @end table If @var{file} is a directory, @code{change} watches for file creation -or deletion in that directory. Some of the file notification backends -report also file changes. This does not work recursively. +and deletion in that directory. Some of the native file notification +libraries also report file changes in that case. This does not work +recursively. When any event happens, Emacs will call the @var{callback} function passing it a single argument @var{event}, which is of the form @@ -3169,19 +3213,20 @@ reports attribute changes as well @item attribute-changed a @var{file} attribute was changed @item stopped -watching @var{file} has been stopped +watching @var{file} has stopped @end table Note that the @file{w32notify} library does not report @code{attribute-changed} events. When some file's attribute, like permissions or modification time, has changed, this library reports a @code{changed} event. Likewise, the @file{kqueue} library does not -report reliably file attribute changes when watching a directory. +reliably report file attribute changes when watching a directory. -The @code{stopped} event reports, that watching the file has been -stopped. This could be because @code{file-notify-rm-watch} was called -(see below), or because the file being watched was deleted, or due to -another error reported from the underlying library. +The @code{stopped} event means that watching the file has been +discontinued. This could be because @code{file-notify-rm-watch} was +called (see below), or because the file being watched was deleted, or +due to another error reported from the underlying library which makes +further watching impossible. @var{file} and @var{file1} are the name of the file(s) whose event is being reported. For example: @@ -3225,7 +3270,7 @@ being reported. For example: @end group @end example -Whether the action @code{renamed} is returned, depends on the used +Whether the action @code{renamed} is returned depends on the used watch library. Otherwise, the actions @code{deleted} and @code{created} could be returned in a random order. diff --git a/doc/lispref/streams.texi b/doc/lispref/streams.texi index 8f8562cadc8..781a50f5c49 100644 --- a/doc/lispref/streams.texi +++ b/doc/lispref/streams.texi @@ -685,6 +685,15 @@ This function outputs @var{character} to @var{stream}. It returns @var{character}. @end defun +@defun flush-standard-output +If you have Emacs-based batch scripts that send output to the +terminal, Emacs will automatically display the output whenever you +write a newline characters to @code{standard-output}. This function +allows you to flush to @code{standard-output} without sending a +newline character first, which enables you to display incomplete +lines. +@end defun + @defun prin1-to-string object &optional noescape @cindex object to string This function returns a string containing the text that @code{prin1} diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi index d31807ad2aa..5e41f8d57bf 100644 --- a/doc/lispref/strings.texi +++ b/doc/lispref/strings.texi @@ -434,9 +434,12 @@ display purposes; use @code{truncate-string-to-width} or (@pxref{Size of Displayed Text}). @end defun -@defun string-lines string &optional omit-nulls +@defun string-lines string &optional omit-nulls keep-newlines Split @var{string} into a list of strings on newline boundaries. If -@var{omit-nulls}, remove empty lines from the results. +the optional argument @var{omit-nulls} is non-@code{nil}, remove empty +lines from the results. If the optional argument @var{keep-newlines} +is non-@code{nil}, don't remove the trailing newlines from the result +strings. @end defun @defun string-pad string length &optional padding start diff --git a/doc/lispref/symbols.texi b/doc/lispref/symbols.texi index 9e44348b671..336fa9c9182 100644 --- a/doc/lispref/symbols.texi +++ b/doc/lispref/symbols.texi @@ -775,7 +775,7 @@ For most purposes, when the flag variable @code{symbols-with-pos-enabled} is non-@code{nil}, symbols with positions behave just as bare symbols do. For example, @samp{(eq #<symbol foo at 12345> foo)} has a value @code{t} when that variable -is set (but nil when it isn't set). Most of the time in Emacs this +is set (but @code{nil} when it isn't set). Most of the time in Emacs this variable is @code{nil}, but the byte compiler binds it to @code{t} when it runs. diff --git a/doc/lispref/syntax.texi b/doc/lispref/syntax.texi index 9120e637274..e84b901eaa9 100644 --- a/doc/lispref/syntax.texi +++ b/doc/lispref/syntax.texi @@ -770,7 +770,7 @@ This function returns the parser state that the parser would reach at position @var{pos} starting from the beginning of the visible portion of the buffer. @iftex -See the next section for +See the next section @end iftex @ifnottex @xref{Parser State}, diff --git a/doc/lispref/text.texi b/doc/lispref/text.texi index ab9abd0495b..a1db715db6e 100644 --- a/doc/lispref/text.texi +++ b/doc/lispref/text.texi @@ -2969,6 +2969,12 @@ character after position @var{pos} in @var{object} (a buffer or string). The argument @var{object} is optional and defaults to the current buffer. +If @var{position} is at the end of @var{object}, the value is +@code{nil}, but note that buffer narrowing does not affect the value. +That is, if @var{object} is a buffer or @code{nil}, and the buffer is +narrowed and @var{position} is at the end of the narrowed buffer, the +result may be non-@code{nil}. + If there is no @var{prop} property strictly speaking, but the character has a property category that is a symbol, then @code{get-text-property} returns the @var{prop} property of that symbol. @@ -3021,6 +3027,12 @@ properties take precedence over this variable. This function returns the entire property list of the character at @var{position} in the string or buffer @var{object}. If @var{object} is @code{nil}, it defaults to the current buffer. + +If @var{position} is at the end of @var{object}, the value is +@code{nil}, but note that buffer narrowing does not affect the value. +That is, if @var{object} is a buffer or @code{nil}, and the buffer is +narrowed and @var{position} is at the end of the narrowed buffer, the +result may be non-@code{nil}. @end defun @defvar default-text-properties @@ -5297,6 +5309,24 @@ interpolation). @code{sqlite-execute} returns the number of affected rows. For instance, an @samp{insert} statement will return @samp{1}, whereas an @samp{update} statement may return zero or a higher number. + +Strings in SQLite are, by default, stored as @code{utf-8}, and +selecting a text column will decode the string using that charset. +Selecting a blob column will return the raw data without any decoding +(i.e., it will return a unibyte string containing the bytes as stored +in the database). Inserting binary data into blob columns, however, +requires some care, as @code{sqlite-execute} will, by default, +interpret all strings as @code{utf-8}. + +So if you have, for instance, @acronym{GIF} data in a unibyte string +called @var{gif}, you have to mark it specially to let +@code{sqlite-execute} know this: + +@lisp +(put-text-property 0 1 'coding-system 'binary gif) +(sqlite-execute db "insert into foo values (?, ?)" (list gif 2)) +@end lisp + @end defun @defun sqlite-select db query &optional values result-type diff --git a/doc/lispref/windows.texi b/doc/lispref/windows.texi index 43f222d57ff..97908bea001 100644 --- a/doc/lispref/windows.texi +++ b/doc/lispref/windows.texi @@ -759,6 +759,15 @@ column and total width (@pxref{Coordinates and Windows}). The optional argument @var{round} behaves as it does for @code{window-total-height}. @end defun +@defun window-max-characters-per-line &optional window face +The maximum width of a line that can be displayed in a window (without +breaking the line) depends on many things, like the font used on the +line, and whether there are fringes around the window. This +convenience function can be used to calculate that number. If +@var{window} isn't given, this defaults to the currently selected +window. if @var{var} isn't given, the @code{default} face is used. +@end defun + @defun window-total-size &optional window horizontal round This function returns either the total height in lines or the total width in columns of the window @var{window}. If @var{horizontal} is @@ -2596,13 +2605,11 @@ default value is an empty display action, i.e., @w{@code{(nil . nil)}}. @defopt display-buffer-alist The value of this option is an alist mapping conditions to display -actions. Each condition may be either a regular expression matching a -buffer name or a function that takes two arguments: a buffer name and -the @var{action} argument passed to @code{display-buffer}. If either -the name of the buffer passed to @code{display-buffer} matches a -regular expression in this alist, or the function specified by a -condition returns non-@code{nil}, then @code{display-buffer} uses the -corresponding display action to display the buffer. +actions. Each condition is passed to @code{buffer-match-p}, along +with the buffer name and the @var{action} argument passed to +@code{display-buffer}. If it returns a non-nil value, then +@code{display-buffer} uses the corresponding display action to display +the buffer. @end defopt @defopt display-buffer-base-action @@ -2968,13 +2975,14 @@ follows: @code{nil} means consider only windows on the selected frame. (Actually, the last frame used that is not a minibuffer-only frame.) @item -@code{t} means consider windows on all frames. -@item @code{visible} means consider windows on all visible frames. @item 0 means consider windows on all visible or iconified frames. @item A frame means consider windows on that frame only. +@item +@code{t} means consider windows on all frames. (Note that this value +is rarely the right thing to use---it might also return a tooltip frame.) @end itemize Note that the meaning of @code{nil} differs slightly from that of the diff --git a/doc/misc/auth.texi b/doc/misc/auth.texi index c2a9aa44371..829d7f4fa03 100644 --- a/doc/misc/auth.texi +++ b/doc/misc/auth.texi @@ -191,7 +191,7 @@ get fancy, the default and simplest configuration is: (setq auth-sources '("secrets:Login")) ;;; use pass (@file{~/.password-store}) ;;; (@pxref{The Unix password store}) -(setq auth-sources '(password-store)) +(auth-source-pass-enable) ;;; JSON data in format [@{ "machine": "SERVER", ;;; "login": "USER", "password": "PASSWORD" @}...] (setq auth-sources '("~/.authinfo.json.gpg")) diff --git a/doc/misc/calc.texi b/doc/misc/calc.texi index d83edc15f30..9bda6af1c5b 100644 --- a/doc/misc/calc.texi +++ b/doc/misc/calc.texi @@ -29877,6 +29877,12 @@ with no argument copies only the number itself into the kill ring, whereas @kbd{C-k} with a prefix argument of 1 copies the number with its trailing newline. +You can customize @code{calc-kill-line-numbering} to nil to exclude +line numbering from kills and copies made by @code{calc-kill} and +@code{calc-copy-as-kill}. This option does not affect calc kill and +copy commands which operate on the region, as that would not make +sense. + @node Yanking Into Stack @section Yanking into the Stack diff --git a/doc/misc/cc-mode.texi b/doc/misc/cc-mode.texi index 8b36d1afd7a..1f12c30b1f8 100644 --- a/doc/misc/cc-mode.texi +++ b/doc/misc/cc-mode.texi @@ -6278,6 +6278,32 @@ expressions for the operands. @comment ------------------------------------------------------------ +@defun c-lineup-argcont-+ +@findex lineup-argcont-+ (c-) +Indent a continued argument @code{c-basic-offset} spaces from the +start of the first argument at the current level of nesting on a +previous line. + +@example +@group +foo (xyz, uvw, aaa + bbb + ccc + + ddd + eee + fff); <- c-lineup-argcont-+ + <--> c-basic-offset +@end group +@end example + +Only continuation lines like this are touched, @code{nil} being +returned on lines which are the start of an argument. + +Within a gcc @code{asm} block, @code{:} is recognized as an argument +separator, but of course only between operand specifications, not in the +expressions for the operands. + +@workswith @code{arglist-cont}, @code{arglist-cont-nonempty}. +@end defun + +@comment ------------------------------------------------------------ + @defun c-lineup-arglist-operators @findex lineup-arglist-operators @r{(c-)} Line up lines starting with an infix operator under the open paren. diff --git a/doc/misc/cl.texi b/doc/misc/cl.texi index a6fe29e1026..6134b977517 100644 --- a/doc/misc/cl.texi +++ b/doc/misc/cl.texi @@ -444,7 +444,7 @@ the ``rest'' argument is bound to the keyword list as it appears in the call. For example: @example -(cl-defun find-thing (thing &rest rest &key need &allow-other-keys) +(cl-defun find-thing (thing thing-list &rest rest &key need &allow-other-keys) (or (apply 'cl-member thing thing-list :allow-other-keys t rest) (if need (error "Thing not found")))) @end example @@ -843,6 +843,7 @@ constructs. * Iteration:: @code{cl-do}, @code{cl-dotimes}, @code{cl-dolist}, @code{cl-do-symbols}. * Loop Facility:: The Common Lisp @code{loop} macro. * Multiple Values:: @code{cl-values}, @code{cl-multiple-value-bind}, etc. +* Macro-Writing Macros:: @code{cl-with-gensyms}, @code{cl-once-only}. @end menu @node Assignment @@ -2513,6 +2514,86 @@ in @code{cl-multiple-value-bind}. Since a perfect emulation is not feasible in Emacs Lisp, this package opts to keep it as simple and predictable as possible. +@node Macro-Writing Macros +@section Macro-Writing Macros + +@noindent +This package includes two classic Common Lisp macro-writing macros to +help render complex macrology easier to read. + +@defmac cl-with-gensyms names@dots{} body +This macro expands to code that executes @var{body} with each of the +variables in @var{names} bound to a fresh uninterned symbol, or +@dfn{gensym}, in Common Lisp parlance. For macros requiring more than +one gensym, use of @code{cl-with-gensyms} shortens the code and +renders one's intentions clearer. Compare: + +@example +(defmacro my-macro (foo) + (let ((bar (gensym "bar")) + (baz (gensym "baz")) + (quux (gensym "quux"))) + `(let ((,bar (+ @dots{}))) + @dots{}))) + +(defmacro my-macro (foo) + (cl-with-gensyms (bar baz quux) + `(let ((,bar (+ @dots{}))) + @dots{}))) +@end example +@end defmac + +@defmac cl-once-only ((variable form)@dots{}) body +This macro is primarily to help the macro programmer ensure that forms +supplied by the user of the macro are evaluated just once by its +expansion even though the result of evaluating the form is to occur +more than once. Less often, this macro is used to ensure that forms +supplied by the macro programmer are evaluated just once. + +Each @var{variable} may be used to refer to the result of evaluating +@var{form} in @var{body}. @code{cl-once-only} binds each +@var{variable} to a fresh uninterned symbol during the evaluation of +@var{body}. Then, @code{cl-once-only} wraps the final expansion in +code to evaluate each @var{form} and bind the result to the +corresponding uninterned symbol. Thus, when the macro writer +substitutes the value for @var{variable} into the expansion they are +effectively referring to the result of evaluating @var{form}, rather +than @var{form} itself. Another way to put this is that each +@var{variable} is bound to an expression for the (singular) result of +evaluating @var{form}. + +The most common case is where @var{variable} is one of the arguments +to the macro being written, so @code{(variable variable)} may be +abbreviated to just @code{variable}. + +For example, consider this macro: + +@example +(defmacro my-list (x y &rest forms) + (let ((x-result (gensym)) + (y-result (gensym))) + `(let ((,x-result ,x) + (,y-result ,y)) + (list ,x-result ,y-result ,x-result ,y-result + (progn ,@@forms)))) +@end example + +In a call like @w{@code{(my-list (pop foo) @dots{})}} the intermediate +binding to @code{x-result} ensures that the @code{pop} is not done +twice. But as a result the code is rather complex: the reader must +keep track of how @code{x-result} really just means the first +parameter of the call to the macro, and the required use of multiple +gensyms to avoid variable capture by @code{(progn ,@@forms)} obscures +things further. @code{cl-once-only} takes care of these details: + +@example +(defmacro my-list (x y &rest forms) + (cl-once-only (x y) + `(list ,x ,y ,x ,y + (progn ,@@forms)))) +@end example +@end defmac + @node Macros @chapter Macros @@ -2868,6 +2949,7 @@ out the property and value cells. @node Creating Symbols @section Creating Symbols +@cindex gensym @noindent These functions create unique symbols, typically for use as @@ -5028,13 +5110,13 @@ The above @code{incf} example could be written using @example (defmacro incf (place &optional n) (gv-letplace (getter setter) place - (macroexp-let2 nil v (or n 1) + (cl-once-only ((v (or n 1))) (funcall setter `(+ ,v ,getter))))) @end example @ignore (defmacro concatf (place &rest args) (gv-letplace (getter setter) place - (macroexp-let2 nil v (mapconcat 'identity args) + (cl-once-only ((v `(mapconcat 'identity ',args))) (funcall setter `(concat ,getter ,v))))) @end ignore @end defmac diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi index 372e4c3ffbd..d35a642b62d 100644 --- a/doc/misc/eshell.texi +++ b/doc/misc/eshell.texi @@ -228,15 +228,39 @@ other background process in Emacs. @node Arguments @section Arguments -Command arguments are passed to the functions as either strings or -numbers, depending on what the parser thinks they look like. If you -need to use a function that takes some other data type, you will need to -call it in an Elisp expression (which can also be used with -@ref{Expansion, expansions}). As with other shells, you can -escape special characters and spaces with the backslash (@code{\}) and -apostrophes (@code{''}) and double quotes (@code{""}). This is needed -especially for file names with special characters like pipe -(@code{|}), which could be part of remote file names. +Ordinarily, command arguments are parsed by Eshell as either strings +or numbers, depending on what the parser thinks they look like. To +specify an argument of some other data type, you can use an +@ref{Dollars Expansion, Elisp expression}: + +@example +~ $ echo (list 1 2 3) +(1 2 3) +@end example + +Additionally, many built-in Eshell commands (@pxref{Built-ins, Eshell +commands}) will flatten the arguments they receive, so passing a list +as an argument will ``spread'' the elements into multiple arguments: + +@example +~ $ printnl (list 1 2) 3 +1 +2 +3 +@end example + +@subsection Quoting and escaping + +As with other shells, you can escape special characters and spaces +with by prefixing the character with a backslash (@code{\}), or by +surrounding the string with apostrophes (@code{''}) or double quotes +(@code{""}). This is needed especially for file names with special +characters like pipe (@code{|}), which could be part of remote file +names. + +When using expansions (@pxref{Expansion}) in an Eshell command, the +result may potentially be of any data type. To ensure that the result +is always a string, the expansion can be surrounded by double quotes. @node Built-ins @section Built-in commands @@ -993,15 +1017,42 @@ parsers (such as @command{cpp} and @command{m4}), but in a command shell, they are less often used for constants, and usually for using variables and string manipulation.@footnote{Eshell has no string-manipulation expansions because the Elisp library already -provides many functions for this.} For example, @code{$var} on a line -expands to the value of the variable @code{var} when the line is +provides many functions for this.} For example, @code{$@var{var}} on +a line expands to the value of the variable @var{var} when the line is executed. Expansions are usually passed as arguments, but may also be -used as commands.@footnote{E.g., entering just @samp{$var} at the prompt -is equivalent to entering the value of @code{var} at the prompt.} +used as commands.@footnote{E.g., entering just @samp{$@var{var}} at +the prompt is equivalent to entering the value of @var{var} at the +prompt.} + +You can concatenate expansions with regular string arguments or even +other expansions. In the simplest case, when the expansion returns a +string value, this is equivalent to ordinary string concatenation; for +example, @samp{$@{echo "foo"@}bar} returns @samp{foobar}. The exact +behavior depends on the types of each value being concatenated: + +@table @asis + +@item both strings +Concatenate both values together. + +@item one or both numbers +Concatenate the string representation of each value, converting back to +a number if possible. + +@item one or both (non-@code{nil}) lists +Concatenate ``adjacent'' elements of each value (possibly converting +back to a number as above). For example, @samp{$list("a" "b")c} +returns @samp{("a" "bc")}. + +@item anything else +Concatenate the string represenation of each value. + +@end table @menu * Dollars Expansion:: * Globbing:: +* Argument Predication and Modification:: @end menu @node Dollars Expansion @@ -1025,11 +1076,22 @@ value, such as @samp{$"@var{var}"-suffix}. @item $(@var{lisp}) Expands to the result of evaluating the S-expression @code{(@var{lisp})}. On its own, this is identical to just @code{(@var{lisp})}, but with the @code{$}, -it can be used in a string, such as @samp{/some/path/$(@var{lisp}).txt}. +it can be used inside double quotes or within a longer string, such as +@samp{/some/path/$(@var{lisp}).txt}. @item $@{@var{command}@} -Returns the output of @command{@var{command}}, which can be any valid Eshell -command invocation, and may even contain expansions. +Returns the output of @command{@var{command}}, which can be any valid +Eshell command invocation, and may even contain expansions. Similar +to @code{$(@var{lisp})}, this is identical to @code{@{@var{command}@}} +when on its own, but the @code{$} allows it to be used inside double +quotes or as part of a string. + +Normally, the output is split line-by-line, returning a list (or the +first element if there's only one line of output); if +@code{eshell-convert-numeric-arguments} is non-@code{nil} and every +line of output looks like a number, convert each line to a number. +However, when this expansion is surrounded by double quotes, it +returns the output as a single string instead. @item $<@var{command}> As with @samp{$@{@var{command}@}}, evaluates the Eshell command invocation @@ -1089,15 +1151,345 @@ the result of @var{expr} is not a string or a sequence. @node Globbing @section Globbing -Eshell's globbing syntax is very similar to that of Zsh. Users coming -from Bash can still use Bash-style globbing, as there are no -incompatibilities. Most globbing is pattern-based expansion, but there -is also predicate-based expansion. @xref{Filename Generation, , , -zsh, The Z Shell Manual}, -for full syntax. To customize the syntax and behavior of globbing in -Eshell see the Customize@footnote{@xref{Easy Customization, , , emacs, -The GNU Emacs Manual}.} -groups ``eshell-glob'' and ``eshell-pred''. +@vindex eshell-glob-case-insensitive +Eshell's globbing syntax is very similar to that of Zsh +(@pxref{Filename Generation, , , zsh, The Z Shell Manual}). Users +coming from Bash can still use Bash-style globbing, as there are no +incompatibilities. + +By default, globs are case sensitive, except on MS-DOS/MS-Windows +systems. You can control this behavior via the +@code{eshell-glob-case-insensitive} option. You can further customize +the syntax and behavior of globbing in Eshell via the Customize group +``eshell-glob'' (@pxref{Easy Customization, , , emacs, The GNU Emacs +Manual}). + +@table @samp + +@item * +Matches any string (including the empty string). For example, +@samp{*.el} matches any file with the @file{.el} extension. + +@item ? +Matches any single character. For example, @samp{?at} matches +@file{cat} and @file{bat}, but not @file{goat}. + +@item **/ +Matches zero or more subdirectories in a file name. For example, +@samp{**/foo.el} matches @file{foo.el}, @file{bar/foo.el}, +@file{bar/baz/foo.el}, etc. Note that this cannot be combined with +any other patterns in the same file name segment, so while +@samp{foo/**/bar.el} is allowed, @samp{foo**/bar.el} is not. + +@item ***/ +Like @samp{**/}, but follows symlinks as well. + +@cindex character sets, in Eshell glob patterns +@cindex character classes, in Eshell glob patterns +@item [ @dots{} ] +Defines a @dfn{character set} (@pxref{Regexps, , , emacs, The GNU +Emacs Manual}). A character set matches characters between the two +brackets; for example, @samp{[ad]} matches @file{a} and @file{d}. You +can also include ranges of characters in the set by separating the +start and end with @samp{-}. Thus, @samp{[a-z]} matches any +lower-case @acronym{ASCII} letter. Note that, unlike in Zsh, +character ranges are interpreted in the Unicode codepoint order, not +in the locale-dependent collation order. + +Additionally, you can include @dfn{character classes} in a character +set. A @samp{[:} and balancing @samp{:]} enclose a character class +inside a character set. For instance, @samp{[[:alnum:]]} +matches any letter or digit. @xref{Char Classes, , , elisp, The Emacs +Lisp Reference Manual}, for a list of character classes. + +@cindex complemented character sets, in Eshell glob patterns +@item [^ @dots{} ] +Defines a @dfn{complemented character set}. This behaves just like a +character set, but matches any character @emph{except} the ones +specified. + +@cindex groups, in Eshell glob patterns +@item ( @dots{} ) +Defines a @dfn{group}. A group matches the pattern between @samp{(} +and @samp{)}. Note that a group can only match a single file name +component, so a @samp{/} inside a group will signal an error. + +@item @var{x}|@var{y} +Inside of a group, matches either @var{x} or @var{y}. For example, +@samp{e(m|sh)-*} matches any file beginning with @file{em-} or +@file{esh-}. + +@item @var{x}# +Matches zero or more copies of the glob pattern @var{x}. For example, +@samp{fo#.el} matches @file{f.el}, @file{fo.el}, @file{foo.el}, etc. + +@item @var{x}## +Matches one or more copies of the glob pattern @var{x}. Thus, +@samp{fo#.el} matches @file{fo.el}, @file{foo.el}, @file{fooo.el}, +etc. + +@item @var{x}~@var{y} +Matches anything that matches the pattern @var{x} but not @var{y}. For +example, @samp{[[:digit:]]#~4?} matches @file{1} and @file{12}, but +not @file{42}. Note that unlike in Zsh, only a single @samp{~} +operator can be used in a pattern, and it cannot be inside of a group +like @samp{(@var{x}~@var{y})}. + +@end table + +@node Argument Predication and Modification +@section Argument Predication and Modification +@cindex argument predication +@cindex argument modification +Eshell supports @dfn{argument predication}, to filter elements of a +glob, and @dfn{argument modification}, to manipulate argument values. +These are similar to glob qualifiers in Zsh (@pxref{Glob Qualifiers, , +, zsh, The Z Shell Manual}). + +Predicates and modifiers are introduced with @samp{(@var{filters})} +after any list argument, where @var{filters} is a list of predicates +or modifiers. For example, @samp{*(.)} expands to all regular files +in the current directory and @samp{*(^@@:U^u0)} expands to all +non-symlinks not owned by @code{root}, upper-cased. + +Some predicates and modifiers accept string parameters, such as +@samp{*(u'@var{user}')}, which matches all files owned by @var{user}. +These parameters must be surrounded by delimiters; you can use any of +the following pairs of delimiters: @code{"@dots{}"}, @code{'@dots{}'}, +@code{/@dots{}/}, @code{|@dots{}|}, @code{(@dots{})}, +@code{[@dots{}]}, @code{<@dots{}>}, or @code{@{@dots{}@}}. + +You can customize the syntax and behavior of predicates and modifiers +in Eshell via the Customize group ``eshell-pred'' (@pxref{Easy +Customization, , , emacs, The GNU Emacs Manual}). + +@menu +* Argument Predicates:: +* Argument Modifiers:: +@end menu + +@node Argument Predicates +@subsection Argument Predicates +You can use argument predicates to filter lists of file names based on +various properties of those files. This is most useful when combined +with globbing, but can be used on any list of files names. Eshell +supports the following argument predicates: + +@table @asis + +@item @samp{/} +Matches directories. + +@item @samp{.} @r{(Period)} +Matches regular files. + +@item @samp{@@} +Matches symbolic links. + +@item @samp{=} +Matches sockets. + +@item @samp{p} +Matches named pipes. + +@item @samp{%} +Matches block or character devices. + +@item @samp{%b} +Matches block devices. + +@item @samp{%c} +Matches character devices. + +@item @samp{*} +Matches regular files that can be executed by the current user. + +@item @samp{r} +@item @samp{A} +@item @samp{R} +Matches files that are readable by their owners (@samp{r}), their +groups (@samp{A}), or the world (@samp{R}). + +@item @samp{w} +@item @samp{I} +@item @samp{W} +Matches files that are writable by their owners (@samp{w}), their +groups (@samp{I}), or the world (@samp{W}). + +@item @samp{x} +@item @samp{E} +@item @samp{X} +Matches files that are executable by their owners (@samp{x}), their +groups (@samp{E}), or the world (@samp{X}). + +@item @samp{s} +Matches files with the setuid flag set. + +@item @samp{S} +Matches files with the setgid flag set. + +@item @samp{t} +Matches files with the sticky bit set. + +@item @samp{U} +Matches files owned by the current effective user ID. + +@item @samp{G} +Matches files owned by the current effective group ID. + +@item @samp{l@option{[+-]}@var{n}} +Matches files with @var{n} links. With @option{+} (or @option{-}), +matches files with more than (or less than) @var{n} links, +respectively. + +@item @samp{u@var{uid}} +@item @samp{u'@var{user-name}'} +Matches files owned by user ID @var{uid} or user name @var{user-name}. + +@item @samp{g@var{gid}} +@item @samp{g'@var{group-name}'} +Matches files owned by group ID @var{gid} or group name +@var{group-name}. + +@item @samp{a@option{[@var{unit}]}@option{[+-]}@var{n}} +@item @samp{a@option{[+-]}'@var{file}'} +Matches files last accessed exactly @var{n} days ago. With @option{+} +(or @option{-}), matches files accessed more than (or less than) +@var{n} days ago, respectively. + +With @var{unit}, @var{n} is a quantity in that unit of time, so +@samp{aw-1} matches files last accessed within one week. @var{unit} +can be @samp{M} (30-day months), @samp{w} (weeks), @samp{h} (hours), +@samp{m} (minutes), or @samp{s} (seconds). + +If @var{file} is specified instead, compare against the modification +time of @file{file}. Thus, @samp{a-'hello.txt'} matches all files +accessed after @file{hello.txt} was last accessed. + +@item @samp{m@option{[@var{unit}]}@option{[+-]}@var{n}} +@item @samp{m@option{[+-]}'@var{file}'} +Like @samp{a}, but examines modification time. + +@item @samp{c@option{[@var{unit}]}@option{[+-]}@var{n}} +@item @samp{c@option{[+-]}'@var{file}'} +Like @samp{a}, but examines status change time. + +@item @samp{L@option{[@var{unit}]}@option{[+-]}@var{n}} +Matches files exactly @var{n} bytes in size. With @option{+} (or +@option{-}), matches files larger than (or smaller than) @var{n} +bytes, respectively. + +With @var{unit}, @var{n} is a quantity in that unit of size, so +@samp{Lm+5} matches files larger than 5 MiB in size. @var{unit} can +be one of the following (case-insensitive) characters: @samp{m} +(megabytes), @samp{k} (kilobytes), or @samp{p} (512-byte blocks). + +@end table + +The @samp{^} and @samp{-} operators are not argument predicates +themselves, but they modify the behavior of all subsequent predicates. +@samp{^} inverts the meaning of subsequent predicates, so +@samp{*(^RWX)} expands to all files whose permissions disallow the +world from accessing them in any way (i.e., reading, writing to, or +modifying them). When examining a symbolic link, @samp{-} applies the +subsequent predicates to the link's target instead of the link itself. + +@node Argument Modifiers +@subsection Argument Modifiers +You can use argument modifiers to manipulate argument values. For +example, you can sort lists, remove duplicate values, capitalize +words, etc. All argument modifiers are prefixed by @samp{:}, so +@samp{$exec-path(:h:u:x/^\/home/)} lists all of the unique parent +directories of the elements in @code{exec-path}, excluding those in +@file{/home}. + +@table @samp + +@item E +Re-evaluates the value as an Eshell argument. For example, if +@var{foo} is @code{"$@{echo hi@}"}, then the result of @samp{$foo(:E)} +is @code{hi}. + +@item L +Converts the value to lower case. + +@item U +Converts the value to upper case. + +@item C +Capitalizes the value. + +@item h +Treating the value as a file name, gets the directory name (the +``head''). For example, @samp{foo/bar/baz.el(:h)} expands to +@samp{foo/bar/}. + +@item t +Treating the value as a file name, gets the base name (the ``tail''). +For example, @samp{foo/bar/baz.el(:h)} expands to @samp{baz.el}. + +@item e +Treating the value as a file name, gets the final extension of the +file, excluding the dot. For example, @samp{foo.tar.gz(:e)} +expands to @code{gz}. + +@item r +Treating the value as a file name, gets the file name excluding the +final extension. For example, @samp{foo/bar/baz.tar.gz(:r)} expands +to @samp{foo/bar/baz.tar}. + +@item q +Marks that the value should be interpreted by Eshell literally, so +that any special characters like @samp{$} no longer have any special +meaning. + +@item s/@var{pattern}/@var{replace}/ +Replaces the first instance of the regular expression @var{pattern} +with @var{replace}. Signals an error if no match is found. + +As with other modifiers taking string parameters, you can use +different delimiters to separate @var{pattern} and @var{replace}, such +as @samp{s'@dots{}'@dots{}'}, @samp{s[@dots{}][@dots{}]}, or even +@samp{s[@dots{}]/@dots{}/}. + +@item gs/@var{pattern}/@var{replace}/ +Replaces all instances of the regular expression @var{pattern} with +@var{replace}. + +@item i/@var{pattern}/ +Filters a list of values to include only the elements matching the +regular expression @var{pattern}. + +@item x/@var{pattern}/ +Filters a list of values to exclude all the elements matching the +regular expression @var{pattern}. + +@item S +@item S/@var{pattern}/ +Splits the value using the regular expression @var{pattern} as a +delimiter. If @var{pattern} is omitted, split on spaces. + +@item j +@item j/@var{delim}/ +Joins a list of values, inserting the string @var{delim} between each +value. If @var{delim} is omitted, use a single space as the +delimiter. + +@item o +Sorts a list of strings in ascending lexicographic order, comparing +pairs of characters according to their character codes (@pxref{Text +Comparison, , , elisp, The Emacs Lisp Reference Manual}). + +@item O +Sorts a list of strings in descending lexicographic order. + +@item u +Removes any duplicate elements from a list of values. + +@item R +Reverses the order of a list of values. + +@end table @node Input/Output @chapter Input/Output @@ -1241,6 +1633,7 @@ Eshell module.} You also need to load the following as shown: * Key rebinding:: * Smart scrolling:: * Terminal emulation:: +* Electric forward slash:: @end menu @node Writing a module @@ -1273,6 +1666,61 @@ This section is not yet written. This section is not yet written. +@node Electric forward slash +@section Electric forward slash + +To help with supplying absolute file name arguments to remote +commands, you can add the @code{eshell-elecslash} module to +@code{eshell-modules-list}. Then, typing @kbd{/} as the first +character of a command line argument will automatically insert the +Tramp prefix @file{/method:host:}. If this is not what you want +(e.g.@: because you want to refer to a local file), you can type +another @kbd{/} to undo the automatic insertion. Typing @kbd{~/} also +inserts the Tramp prefix. The automatic insertion applies only when +@code{default-directory} is remote and the command is a Lisp function. +In particular, typing arguments to external commands doesn't insert +the prefix. + +The result is that in most cases of supplying absolute file name +arguments to commands you should see the Tramp prefix inserted +automatically only when that's what you'd reasonably expect. This +frees you from having to keep track of whether commands are Lisp +functions or external when typing command line arguments. For +example, suppose you execute + +@example + cd /ssh:root@@example.com: + find /etc -name "*gnu*" +@end example + +@noindent and in reviewing the output of the command, you identify a +file @file{/etc/gnugnu} that should be moved somewhere else. So you +type + +@example + mv /etc/gnugnu /tmp +@end example + +@noindent But since @command{mv} refers to the local Lisp function +@code{eshell/mv}, not a remote shell command, to say this is to +request that the local file @file{/etc/gnugnu} be moved into the local +@file{/tmp} directory. After you add @code{eshell-elecslash} to +@code{eshell-modules-list}, then when you type the above @command{mv} +invocation you will get the following input, which is what you +intended: + +@example + mv /ssh:root@@example.com:/etc/gnugnu /ssh:root@@example.com:/tmp +@end example + +The code that determines whether or not the Tramp prefix should be +inserted uses simple heuristics. A limitation of the current +implementation is that it inspects whether only the command at the +very beginning of input is a Lisp function or external program. Thus +when chaining commands with the operators @code{&&}, @code{||}, +@code{|} and @code{;}, the electric forward slash is active only +within the first command. + @node Bugs and ideas @chapter Bugs and ideas @cindex reporting bugs and ideas @@ -1676,11 +2124,12 @@ only. That way, it could be listed as a login shell. @item The first keypress after @kbd{M-x watson} triggers @code{eshell-send-input} -@item Make @kbd{/} electric +@item Make @kbd{/} more electric -So that it automatically expands and corrects pathnames. Or make -pathname completion for Pcomplete auto-expand @samp{/u/i/std@key{TAB}} to -@samp{/usr/include/std@key{TAB}}. +@noindent so that it automatically expands and corrects file names, +beyond what the @code{em-elecslash} module is able to do. Or make +file name completion for Pcomplete auto-expand +@samp{/u/i/std@key{TAB}} to @samp{/usr/include/std@key{TAB}}. @item Write the @command{pushd} stack to disk along with @code{last-dir-ring} diff --git a/doc/misc/eudc.texi b/doc/misc/eudc.texi index 71e3e6b9ed7..d2850282fea 100644 --- a/doc/misc/eudc.texi +++ b/doc/misc/eudc.texi @@ -254,7 +254,9 @@ To: * Smith @noindent will return all LDAP entries with surnames that begin with @code{Smith}. In every LDAP query it makes, EUDC implicitly appends -the wildcard character to the end of the last word. +the wildcard character to the end of the last word, except if the word +corresponds to an attribute which is a member of +`eudc-ldap-no-wildcard-attributes'. @menu * Emacs-only Configuration:: Configure with @file{.emacs} diff --git a/doc/misc/eww.texi b/doc/misc/eww.texi index 6d1ba3962f3..f23180c1d4e 100644 --- a/doc/misc/eww.texi +++ b/doc/misc/eww.texi @@ -311,11 +311,9 @@ state the directionality. size or content. By customizing @code{shr-max-image-proportion} you can set the maximal image proportion in relation to the window they are displayed in. E.g., 0.7 means an image is allowed to take up 70% -of the width and height. If Emacs supports image scaling (ImageMagick -support required) then larger images are scaled down. You can block -specific images completely by customizing @code{shr-blocked-images}, -or, if you want to only allow some specific images, customize -@code{shr-allowed-images}. +of the width and height. If Emacs supports image scaling, then larger +images are scaled down. You can block specific images completely by +customizing @code{shr-blocked-images}. @vindex shr-inhibit-images You can control image display by customizing diff --git a/doc/misc/flymake.texi b/doc/misc/flymake.texi index 0db02608dd2..953e4605e98 100644 --- a/doc/misc/flymake.texi +++ b/doc/misc/flymake.texi @@ -265,6 +265,9 @@ This section summarizes customization variables used for the configuration of the Flymake user interface. @vtable @code +@item flymake-mode-line-lighter +The name of the mode. Defaults to @samp{Flymake}. + @item flymake-mode-line-format Format to use for the Flymake mode line indicator. diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index 9faace1a75e..e51ae7d424d 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -24168,15 +24168,12 @@ If you want to see them in the Cc and To fields, set: @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}. +or a symbol referring to a list. @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}. +or a symbol referring to a list. @end table diff --git a/doc/misc/info.texi b/doc/misc/info.texi index 6ebf60ce360..4db35ebf0fc 100644 --- a/doc/misc/info.texi +++ b/doc/misc/info.texi @@ -1083,7 +1083,9 @@ If you aren't sure which manual documents the topic you are looking for, try the @kbd{M-x info-apropos} command in Emacs, or the @kbd{M-x index-apropos} command in the stand-alone reader. It prompts for a string and then looks up that string in all the indices of all the -Info documents installed on your system. +Info documents installed on your system. In Emacs, giving a prefix +argument to the command will try to search for a regular expression +instead of a string. @node Go to node @section @kbd{g} goes to a node by name diff --git a/doc/misc/org.org b/doc/misc/org.org index 60af81ea2cf..3dce83c936b 100644 --- a/doc/misc/org.org +++ b/doc/misc/org.org @@ -6405,7 +6405,7 @@ special repeaters =++= and =.+=. For example: Marking this DONE shifts the date to one month after today. ,** TODO Wash my hands - DEADLINE: <2019-04-05 08:00 Sun .+1h> + DEADLINE: <2019-04-05 08:00 Fri .+1h> Marking this DONE shifts the date to exactly one hour from now. #+end_example diff --git a/doc/misc/rcirc.texi b/doc/misc/rcirc.texi index b18ab2a6b29..8253e404084 100644 --- a/doc/misc/rcirc.texi +++ b/doc/misc/rcirc.texi @@ -154,8 +154,11 @@ deego: fsbot rules! @cindex nick completion @cindex completion of nicks +@vindex rcirc-cycle-completion-flag @kindex TAB Since this is so common, you can use @key{TAB} to do nick completion. +By default rcirc will use the default completion system, but you can +enable @code{rcirc-cycle-completion-flag} to cycle nicks in place. @node Getting started with rcirc @section Getting started with rcirc diff --git a/doc/misc/texinfo.tex b/doc/misc/texinfo.tex index 58b6abee78c..8872e5e055f 100644 --- a/doc/misc/texinfo.tex +++ b/doc/misc/texinfo.tex @@ -3,9 +3,9 @@ % Load plain if necessary, i.e., if running under initex. \expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi % -\def\texinfoversion{2022-01-02.12} +\def\texinfoversion{2022-04-09.08} % -% Copyright 1985, 1986, 1988, 1990-2021 Free Software Foundation, Inc. +% Copyright 1985, 1986, 1988, 1990-2022 Free Software Foundation, Inc. % % This texinfo.tex file is free software: you can redistribute it and/or % modify it under the terms of the GNU General Public License as @@ -3171,16 +3171,8 @@ end % Default is `distinct'. \kbdinputstyle distinct -% @kbd is like @code, except that if the argument is just one @key command, -% then @kbd has no effect. -\def\kbd#1{{\def\look{#1}\expandafter\kbdsub\look??\par}} - -\def\xkey{\key} -\def\kbdsub#1#2#3\par{% - \def\one{#1}\def\three{#3}\def\threex{??}% - \ifx\one\xkey\ifx\threex\three \key{#2}% - \else{\tclose{\kbdfont\setcodequotes\look}}\fi - \else{\tclose{\kbdfont\setcodequotes\look}}\fi +\def\kbd#1{% + \tclose{\kbdfont\setcodequotes#1}% } % definition of @key that produces a lozenge. Doesn't adjust to text size. @@ -4417,7 +4409,7 @@ $$% % Find the correct column width \hsize=\expandafter\csname col\the\colcount\endcsname % - \rightskip=0pt + \advance\rightskip by -1\rightskip % Zero leaving only any stretch \ifnum\colcount=1 \advance\hsize by\leftskip % Add indent of surrounding text \else @@ -5961,7 +5953,7 @@ might help (with 'rm \jobname.?? \jobname.??s')% % Chapters, sections, etc. % Let's start with @part. -\outer\parseargdef\part{\partzzz{#1}} +\parseargdef\part{\partzzz{#1}} \def\partzzz#1{% \chapoddpage \null @@ -8680,9 +8672,11 @@ might help (with 'rm \jobname.?? \jobname.??s')% } \def\wordTop{Top} -% Until the next @node or @bye command, divert output to a box that is not -% output. -\def\ignorenode{\setbox\dummybox\vbox\bgroup\def\node{\egroup\node}% +% Until the next @node, @part or @bye command, divert output to a box that +% is not output. +\def\ignorenode{\setbox\dummybox\vbox\bgroup +\def\part{\egroup\part}% +\def\node{\egroup\node}% \ignorenodebye } @@ -9391,13 +9385,12 @@ might help (with 'rm \jobname.?? \jobname.??s')% \catcode`\^^M = 5 % in case we're inside an example \normalturnoffactive % allow _ et al. in names \makevalueexpandable - % If the image is by itself, center it. \ifvmode \imagevmodetrue \else \ifx\centersub\centerV % for @center @image, we need a vbox so we can have our vertical space \imagevmodetrue - \vbox\bgroup % vbox has better behavior than vtop herev + \vbox\bgroup % vbox has better behavior than vtop here \fi\fi % \ifimagevmode @@ -9405,11 +9398,14 @@ might help (with 'rm \jobname.?? \jobname.??s')% % Usually we'll have text after the image which will insert % \parskip glue, so insert it here too to equalize the space % above and below. - \nobreak\vskip\parskip - \nobreak + \vskip\parskip + % + % Place image in a \vtop for a top page margin that is (close to) correct, + % as \topskip glue is relative to the first baseline. + \vtop\bgroup\hrule height 0pt\vskip-\parskip \fi % - % Leave vertical mode so that indentation from an enclosing + % Enter horizontal mode so that indentation from an enclosing % environment such as @quotation is respected. % However, if we're at the top level, we don't want the % normal paragraph indentation. @@ -9438,6 +9434,7 @@ might help (with 'rm \jobname.?? \jobname.??s')% \fi % \ifimagevmode + \egroup \medskip % space after a standalone image \fi \ifx\centersub\centerV \egroup \fi @@ -10898,6 +10895,9 @@ directory should work if nowhere else does.} \DeclareUnicodeCharacter{1EF8}{\~Y}% \DeclareUnicodeCharacter{1EF9}{\~y}% % + % Exotic spaces + \DeclareUnicodeCharacter{2007}{\hphantom{0}}% + % % Punctuation \DeclareUnicodeCharacter{2013}{--}% \DeclareUnicodeCharacter{2014}{---}% diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 3cc312d2f5e..bb91aec0cc0 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -2649,6 +2649,41 @@ The most common @value{tramp} connection family is based on either configuration recommendations are given. +@subsection Using ssh config include for host name completion + +@vindex Include@r{, ssh option} +@findex tramp-set-completion-function +@findex tramp-get-completion-function +OpenSSH configuration files can use an @option{Include} option for +further configuration files. Default @value{tramp} host name +completion ignores this option. However, you can configure this +yourself. + +Given, your @file{~/.ssh/config} file contains the following option: + +@example +Include ~/.ssh/conf.d/* +@end example + +The following code snippet in your @file{.emacs} uses all files in +that directory for host name completion: + +@lisp +@group +(tramp-set-completion-function + "ssh" (append (tramp-get-completion-function "ssh") + (mapcar (lambda (file) `(tramp-parse-sconfig ,file)) + (directory-files + "~/.ssh/conf.d/" + 'full directory-files-no-dot-files-regexp)))) +@end group +@end lisp + +This code snippet does it for the @option{ssh} method. If you replace +@t{"ssh"} by @t{"scp"}, it does it also for that method (or any other +method you like). + + @subsection Detection of session hangouts @vindex ServerAliveInterval@r{, ssh option} @@ -4041,9 +4076,9 @@ inspect @value{tramp} @ref{Traces and Profiles, traces}. @findex list-system-processes @findex process-attributes The functions @code{list-system-processes} and -@code{process-attributes} return information about processes on the -respective remote host. In order to retrieve this information, they -use the command @command{ps}, driven by the following constants: +@code{process-attributes} return information about system processes on +the respective remote host. In order to retrieve this information, +they use the command @command{ps}, driven by the following constants: @defvr Constant tramp-process-attributes-ps-args This is a list of arguments (strings) @command{ps} is called with. diff --git a/doc/misc/vtable.texi b/doc/misc/vtable.texi index 472dee70ec0..296dc520a1b 100644 --- a/doc/misc/vtable.texi +++ b/doc/misc/vtable.texi @@ -88,9 +88,9 @@ Here's just about the simplest vtable that can be created: ("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). +By default, vtable uses the @code{vtable} face (which inherits from +the @code{variable-pitch} face), and right-aligns columns that have +only numerical data (and left-aligns the rest). You'd normally want to name the columns: @@ -383,9 +383,27 @@ 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. +The face to be used. This defaults to @code{vtable}. This face +doesn't override the faces in the data, or the faces supplied by the +getter and formatter functions. + +@item :row-colors +If present, this should be a list of color names to be used as the +background color on the rows. If there are fewer colors here than +there are rows, the rows will be repeated. The most common use +case here is to have alternating background colors on the rows, so +this would usually be a list of two colors. This can also be a list +of faces to be used. + +@item :column-colors +If present, this should be a list of color names to be used as the +background color on the columns. If there are fewer colors here than +there are columns, the colors will be repeated. The most common use +case here is to have alternating background colors on the columns, so +this would usually be a list of two colors. This can also be a list +of faces to be used. If both @code{:row-colors} and +@code{:column-colors} is present, the colors will be ``blended'' to +produce the final colors in the table. @item :actions This uses the same syntax as @code{define-keymap}, but doesn't refer @@ -402,6 +420,13 @@ current line, they can use the @code{vtable-current-object} function @item :separator-width The width of the blank space between columns. +@item :divider-width +@itemx :divider +You can have a divider inserted between the columns. This can either +be specified by using @code{:divider}, which should be a string to be +displayed between the columns, or @code{:divider-width}, which +specifies the width of the space to be used as the divider. + @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) diff --git a/etc/AUTHORS b/etc/AUTHORS index 0029a4b97f2..f961852cee6 100644 --- a/etc/AUTHORS +++ b/etc/AUTHORS @@ -1574,8 +1574,8 @@ Eli Zaretskii: wrote [bidirectional display in xdisp.c] and co-wrote help-tests.el and changed xdisp.c display.texi w32.c msdos.c w32fns.c simple.el files.el fileio.c keyboard.c emacs.c w32term.c text.texi dispnew.c - w32proc.c files.texi frames.texi configure.ac lisp.h dispextern.h - process.c editfns.c and 1232 other files + w32proc.c files.texi frames.texi configure.ac dispextern.h lisp.h + process.c ms-w32.h and 1236 other files Eliza Velasquez: changed server.el @@ -2610,10 +2610,10 @@ Jimmy Yuen Ho Wong: changed nsm.el gnutls.c gnutls.el disass.el Jim Paris: changed process.c Jim Porter: changed delsel.el ansi-color-tests.el ansi-color.el - bindings.el term-tests.el term.el tramp.el callproc.c - dichromacy-theme.el diff-mode.el files-tests.el gdb-mi.el grep-tests.el - ispell.el leuven-theme.el man.el menu-bar.el misterioso-theme.el - process.c process.h progmodes/grep.el and 6 other files + bindings.el esh-var.el term-tests.el term.el tramp.el callproc.c + dichromacy-theme.el diff-mode.el em-pred.el eshell-tests.el eshell.texi + files-tests.el gdb-mi.el grep-tests.el ispell.el leuven-theme.el man.el + menu-bar.el and 10 other files Jim Radford: changed gnus-start.el @@ -2950,7 +2950,7 @@ Juri Linkov: wrote compose.el files-x.el misearch.el repeat-tests.el and changed isearch.el simple.el info.el replace.el dired.el dired-aux.el progmodes/grep.el subr.el window.el image-mode.el mouse.el diff-mode.el files.el menu-bar.el minibuffer.el progmodes/compile.el startup.el - faces.el vc.el display.texi search.texi and 444 other files + faces.el vc.el display.texi search.texi and 446 other files Jussi Lahdenniemi: changed w32fns.c ms-w32.h msdos.texi w32.c w32.h w32console.c w32heap.c w32inevt.c w32term.h @@ -3306,7 +3306,7 @@ and co-wrote gnus-kill.el gnus-mh.el gnus-msg.el gnus-score.el rfc2047.el svg.el time-date.el and changed gnus.texi simple.el subr.el files.el process.c text.texi display.texi dired.el gnutls.c gnus-ems.el smtpmail.el help-fns.el - auth-source.el url-http.el edebug.el gnus-cite.el image.el pop3.el + auth-source.el url-http.el edebug.el image.el gnus-cite.el pop3.el dired-aux.el fns.c image.c and 860 other files Lars Rasmusson: changed ebrowse.c @@ -4564,9 +4564,10 @@ and changed xdisp.c comp.c fns.c pdumper.c alloc.c byte-opt.el ccl-tests.el ccl.c ccl.el cmds.c comint.el comp-test-funcs.el comp-tests.el comp.el composite.c and 28 other files -Po Lu: changed xdisp.c browse-url.el callproc.c cc-compat.el config.bat - esh-cmd.el fileio.c langinfo.h loadup.el msdos.c msdos.h nsfns.m - nsterm.m process.c sed1v2.inp sed2v2.inp sed3v2.inp sedlibmk.inp +Po Lu: changed xdisp.c anti.texi browse-url.el callproc.c cc-compat.el + config.bat esh-cmd.el fileio.c langinfo.h loadup.el msdos.c msdos.h + nsfns.m nsterm.m process.c sed1v2.inp sed2v2.inp sed3v2.inp + sedlibmk.inp tooltip.el xterm.c Pontus Michael: changed simple.el @@ -5385,8 +5386,8 @@ and co-wrote ol-gnus.el and changed bug-reference.el reftex-vars.el tex-mode.el browse-url.el gnus.texi reftex-cite.el tsdh-dark-theme.el tsdh-light-theme.el gnus-sum.el maintaining.texi file-notify-tests.el gnus-art.el misc.texi - reftex.el org-gnus.el prog-mode.el subword.el image-mode.el json.el - lisp-mode.el rcirc.el and 99 other files + reftex.el org-gnus.el prog-mode.el subword.el dired.el image-mode.el + json.el lisp-mode.el and 99 other files Tatsuya Ichikawa: changed gnus-agent.el gnus-cache.el diff --git a/etc/HELLO b/etc/HELLO index da9b388f363..dbbcc0493bf 100644 --- a/etc/HELLO +++ b/etc/HELLO @@ -27,9 +27,11 @@ Arabic (العربيّة) السّلام عليكم Armenian (Õ°Õ¡ÕµÕ¥Ö€Õ¥Õ¶) Ô²Õ¡Ö€Ö‡ Õ±Õ¥Õ¦ Belarusian (беларуÑкаÑ) Прывітанне Bengali (বাংলা) নমসà§à¦•à¦¾à¦° +Brahmi (𑀩ð‘†ð‘€ð‘€¸ð‘€³ð‘†ð‘€«ð‘€») 𑀦𑀫𑀲ð‘†ð‘€¢ð‘‚ + Braille ⠓⠑⠇⠇⠕ Burmese (မြန်မာ) မင်္ဂလာပါ -C printf ("Hello, world!\n"); +C printf (<x-color><param>orange red</param>"Hello, world!\n"</x-color>); Cham (ꨌꩌ) ꨦꨤꩌ ꨦê¨ê¨° Cherokee (á£áŽ³áŽ© Ꭶá¬á‚Ꭿáá—) Ꭳáá² / áá² Comanche /kəˈmæntʃiË/ Haa marʉÌawe diff --git a/etc/HISTORY b/etc/HISTORY index 1d6425e9380..bb4e3e38e1b 100644 --- a/etc/HISTORY +++ b/etc/HISTORY @@ -224,6 +224,8 @@ GNU Emacs 27.1 (2020-08-10) emacs-27.1 GNU Emacs 27.2 (2021-03-25) emacs-27.2 +GNU Emacs 28.1 (2022-04-04) emacs-28.1 + ---------------------------------------------------------------------- This file is part of GNU Emacs. @@ -40,13 +40,13 @@ the option '--with-be-app', the resulting Emacs will only run in text-mode terminals. +++ -*** Cairo drawing support has been enabled for Haiku builds. +** Cairo drawing support has been enabled for Haiku builds. To enable Cairo support, ensure that the Cairo and FreeType development files are present on your system, and configure Emacs with '--with-be-cairo'. --- -*** Double buffering is now enabled on the Haiku operating system. +** Double buffering is now enabled on the Haiku operating system. Unlike X, there is no compile-time option to enable or disable double-buffering. If you wish to disable double-buffering, change the frame parameter 'inhibit-double-buffering' instead. @@ -58,25 +58,28 @@ The file is typically installed using a file name akin to If a constant file name is required, the file can be renamed to "emacs.pdmp", and Emacs will find it during startup anyway. -** Emacs now supports use of XInput 2 for input events. -If your X server has support and you have the XInput 2 development headers -installed, you can configure Emacs with the option '--with-xinput2' to enable -this support. +--- +** Emacs now uses of XInput 2 for input events. +If your X server has support and you have the XInput 2 development +headers installed, Emacs will use the X Input Extension for handling +input. If this causes problems, you can configure Emacs with the +option '--without-xinput2' to disable this support. -The named feature 'xinput2' can be used to test for the presence of -XInput 2 support from Lisp programs. +(featurep 'xinput2) can be used to test for the presence of XInput 2 +support from Lisp programs. +++ ** Emacs now supports being built with pure GTK. -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. 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'. +To use this option, make sure the GTK 3 (version 3.20 or later) 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. 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. @@ -90,15 +93,26 @@ as was already the case for all the non-preloaded files. The option 'desktop-load-locked-desktop' can now be set to the value 'check-pid', which means to allow loading a locked ".emacs.desktop" file if the Emacs process which locked it is no longer running on the -local machine. This allows to avoid asking questions about locked -desktop files when the Emacs session which locked it crashes or was -otherwise interrupted and didn't exit gracefully. See the "(emacs) -Saving Emacs Sessions" node in the Emacs manual for more details. +local machine. This allows avoiding questions about locked desktop +files when the Emacs session which locked it crashes, or was otherwise +interrupted, and didn't exit gracefully. See the "(emacs) Saving +Emacs Sessions" node in the Emacs manual for more details. * Startup Changes in Emacs 29.1 +++ +** Emacs can now be used more easily in an executable script. +If you start an executable script with + + #!/usr/bin/emacs -x + +Emacs will start without reading any init files (like with '--quick'), +and then execute the rest of the script file as Emacs Lisp. When it +reaches the end of the script, Emacs will exit with an exit code from +the value of the final form. + ++++ ** Emacs now supports setting 'user-emacs-directory' via '--init-directory'. +++ @@ -123,6 +137,26 @@ of 'user-emacs-directory'. * Incompatible changes in Emacs 29.1 --- +** Sorting commands no longer necessarily change modification status. +In earlier Emacs versions, commands like 'M-x sort-lines' would always +change buffer modification status to "modified", whether they changed +something in the buffer or not. This has been changed: The buffer is +marked as modified only if the sorting ended up changing the contents +of the buffer. + +--- +** 'string-lines' handles trailing newlines differently. +It no longer returns an empty final string if the string ends with a +newline. + +--- +** 'TAB' and '<backtab>' are now bound in 'button-map'. +This means that if your cursor is on a button, 'TAB' will take you to +the next button, even if the mode has bound it to something else. +This also means that 'TAB' on a button in an 'outline-minor-mode' +heading will move point instead of collapsing the outline. + +--- ** 'Info-default-directory-list' is no longer populated at Emacs startup. If you have code in your init file that removes directories from 'Info-default-directory-list', this will no longer work. @@ -154,11 +188,22 @@ files that were compiled with an old EIEIO (Emacs<25). ** 'C-x 8 .' has been moved to 'C-x 8 . .'. This is to open up the 'C-x 8 .' map to bind further characters there. +** Eshell + --- -** 'source' and '.' in Eshell no longer accept the '--help' option. +*** 'source' and '.' no longer accept the '--help' option. This is for compatibility with the shell versions of these commands, which don't handle options like '--help' in any special way. ++++ +*** String delimiters in argument predicates/modifiers are more restricted. +Previously, some argument predicates/modifiers allowed arbitrary +characters as string delimiters. To provide more unified behavior +across all predicates/modifiers, the list of allowed delimiters has +been restricted to "...", '...', /.../, |...|, (...), [...], <...>, +and {...}. See the "(eshell) Argument Predication and Modification" +node in the Eshell manual for more details. + --- ** The 'delete-forward-char' command now deletes by grapheme clusters. This command is by default bound to the <Delete> function key @@ -182,10 +227,30 @@ speakers of the Tamil language. To get back the previous behavior, use the new 'tamil-itrans-digits' and 'tamil-inscript-digits' input methods instead. ++++ +** New variable current-time-list governing default timestamp form. +Functions like current-time now yield (TICKS . HZ) timestamps if this +new variable is nil. The variable defaults to t, which means these +functions default to timestamps of the forms (HI LO US PS), (HI LO US) +or (HI LO), which are less regular and less efficient. This is part +of a long-planned change first documented in Emacs 27. Developers are +encouraged to test timestamp-related code with this variable set to +nil, as it will default to nil in a future Emacs version and will be +removed some time after that. + * Changes in Emacs 29.1 +++ +** New command 'restart-emacs'. +This is like 'save-buffers-kill-emacs', but instead of just killing +the current Emacs process at the end, it starts a new Emacs process +(using the same command line arguments as the running Emacs process). +'kill-emacs' and 'save-buffers-kill-emacs' have also gained new +optional parameters to restart instead of just killing the current +process. + ++++ ** New user option 'mouse-drag-and-drop-region-cross-program'. If non-nil, this option allows dragging text in the region from Emacs to another program. @@ -384,9 +449,41 @@ command also works for non-Emoji characters.) --- *** New input method 'emoji'. +This allows you to enter emoji using short strings, eg :face_palm: or +:scream:. ** Help ++++ +*** New user option 'help-window-keep-selected'. +If non-nil, commands to show the info manual and the source will reuse +the same window the *Help* buffer is shown in. + +--- +*** Commands like 'C-h f' have changed how they describe menu bindings. +For instance, previously a command might be described as having the +following bindings: + + It is bound to <open>, C-x C-f, <menu-bar> <file> <new-file>. + +This has been changed to: + + It is bound to <open> and C-x C-f. + It can also be invoked from the menu: File → Visit New File... + ++++ +*** The 'C-h .' command now accepts a prefix argument. +'C-u C-h .' would previously inhibit displaying a warning message if +there's no local help at point. This has been changed to call +'button-describe'/'widget-describe' and display button/widget help +instead. + +--- +*** New user option 'help-enable-variable-value-editing'. +If enabled, 'e' on a value in *Help* will pop you to a new buffer +where you can edit the value. This is not enabled by default, because +it's easy to make an edit that yields an invalid result. + --- *** 'C-h b' uses outlining by default. Set 'describe-bindings-outline' to nil to get the old behavior. @@ -408,6 +505,16 @@ These will take you (respectively) to the next and previous "page". This will take you to the Emacs Lisp manual entry for the item displayed, if any. +--- +*** The 'C-h m' ('describe-mode') "*Help*" buffer has been reformatted. +It now only includes local minor modes at the start, and the global +minor modes are listed after the major mode. + ++++ +*** The user option 'help-window-select' now affects apropos commands. +The apropos commands will now select the apropos window if +'help-window-select' is non-nil. + ** Outline Mode +++ @@ -434,8 +541,9 @@ This is a list of pairs of open/close strings used to display buttons. +++ ** Support for the WebP image format. This support is built by default when the libwebp library is -available. To disable it, use the '--without-webp' configure flag. -Image specifiers can now use ':type webp'. +available. (This also includes support for animated WebP images.) To +disable WebP support, use the '--without-webp' configure flag. Image +specifiers can now use ':type webp'. ** Windows @@ -499,9 +607,27 @@ are met. The conditions are given by the argument, which can be +++ *** New command 'rcirc-when'. ++++ +*** New user option 'rcirc-cycle-completion-flag'. +Rcirc will use the default 'completion-at-point' mechanism. The +conventional IRC behaviour of completing by cycling through the +available options can be restored by enabling this option. + ++++ +** 'imenu' is now bound to 'M-g i' globally. + * Editing Changes in Emacs 29.1 --- +** 'scroll-other-window' and 'scroll-other-window-down' now respects remapping. +These commands (bound to 'C-M-v' and 'C-M-V') used to scroll the other +windows without looking a customizations in that other window. These +functions now check whether they have been rebound in the buffer in +that other window, and then call the remapped function instead. In +addition, these commands now also respect the +'scroll-error-top-bottom' user option. + +--- ** Indentation of 'cl-flet' and 'cl-labels' has changed. These forms now indent like this: @@ -537,6 +663,7 @@ effectively dragged. Customize this option to limit the number of entries in the menu "Edit->Paste from Kill Menu". The default is 60. ++++ ** Performing a pinch gesture on a touchpad now increases the text scale. ** show-paren-mode @@ -564,10 +691,10 @@ change the terminal used on a remote host. --- *** New user options for alternate wheel events. -The options 'mouse-wheel-down-alternate-event', 'mouse-wheel-up-alternate-event', -'mouse-wheel-left-alternate-event', and 'mouse-wheel-right-alternate-event' have -been added to better support systems where two kinds of wheel events can be -received. +The options 'mouse-wheel-down-alternate-event', +'mouse-wheel-up-alternate-event', 'mouse-wheel-left-alternate-event', +and 'mouse-wheel-right-alternate-event' have been added to better +support systems where two kinds of wheel events can be received. ** Editing complex text layout (CTL) scripts @@ -583,9 +710,60 @@ 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. +*** New language environment "Brahmi". +This language environment supports Brahmi, which is a historical +script that was used in ancient South Asia. A new input method, +'brahmi', is provided to type text in this script. + * Changes in Specialized Modes and Packages in Emacs 29.1 +** Package + ++++ +*** New command 'package-update'. +This command allows you to upgrade packages without using 'M-x +list-packages'. + +** Miscellaneous + ++++ +*** New command 'scratch-buffer'. +This command switches to the *scratch* buffer. If *scratch* doesn't +exist, the command creates it first. You can use this command if you +inadvertently delete the *scratch* buffer. + +** Debugging + +*** New user option 'debug-allow-recursive-debug'. +This user option controls whether the 'e' (in a *Backtrace* +buffer or while edebugging) and 'C-x C-e' (while edebugging) commands +lead to a (further) backtrace. By default, this variable is nil, +which is a change in behaviour from previous Emacs versions. + +** Compile + ++++ +*** New user option 'compilation-max-output-line-length'. +Lines longer than this will have the ends hidden, with a button to +reveal the hidden text. This speeds up operations like grepping on +files that have few newlines. + +** Flymake + ++++ +*** New user option 'flymake-mode-line-lighter'. + ++++ +** New minor mode 'word-wrap-whitespace-mode' for extending 'word-wrap'. +This mode switches 'word-wrap' on, and breaks on all the whitespace +characters instead of just SPC and TAB. + +--- +** New mode, 'emacs-news-mode', for editing the NEWS file. +This mode adds some highlighting, fixes the 'M-q' command, and has +commands for doing maintenance. + --- ** kmacro Kmacros are now OClosures and have a new constructor 'kmacro' which @@ -601,11 +779,12 @@ value. ** Minibuffer and Completions ++++ *** New commands for navigating completions from the minibuffer. When the minibuffer is the current buffer, typing 'M-<up>' or 'M-<down>' selects a previous/next completion candidate from the "*Completions*" buffer and inserts it to the minibuffer. -When the variable 'minibuffer-completion-auto-choose' is nil, +When the user option 'minibuffer-completion-auto-choose' is nil, 'M-<up>' and 'M-<down>' do the same, but without inserting a completion candidate to the minibuffer, then 'M-RET' can be used to choose the currently active candidate from the "*Completions*" @@ -621,11 +800,13 @@ To enable this behavior, customize the user option 'second-tab', then the first 'TAB' will display "*Completions*", and the second one will switch to the "*Completions*" buffer. +--- *** New user option 'completion-wrap-movement'. When non-nil, the commands 'next-completion' and 'previous-completion' automatically wrap around on reaching the beginning or the end of 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, @@ -657,15 +838,25 @@ When this user option names a face, the current candidate in the "*Completions*" buffer is highlighted with that face. The nil value disables this highlighting. +--- *** Choosing a completion with a prefix argument doesn't exit the minibuffer. This means that typing 'C-u RET' on a completion candidate in the "*Completions*" buffer inserts the completion to the minibuffer, -bot doesn't exit the minibuffer. +but doesn't exit the minibuffer. ** Isearch and Replace +++ -*** New user option 'char-fold-override' disables default character equivalences. +*** Changes in how Isearch responds to 'mouse-yank-at-point'. +If a user does 'C-s' and then uses '<mouse-2>' ('mouse-yank-primary') +outside the echo area, Emacs will, by default, end the Isearch and +yank the text at mouse cursor. But if 'mouse-yank-at-point' is +non-nil, the text will now be added to the Isearch instead. + ++++ +*** New user option 'char-fold-override'. +Non-nil means that the default definitions of equivalent characters +are overridden. +++ *** New command 'isearch-emoji-by-name'. @@ -674,6 +865,7 @@ command accepts the Unicode name of an Emoji (for example, "smiling face" or "heart with arrow"), like 'C-x 8 e e', with minibuffer completion, and adds the Emoji into the search string. ++++ ** New minor mode 'glyphless-display-mode'. This allows an easy way to toggle seeing all glyphless characters in the current buffer. @@ -698,6 +890,9 @@ This fills the region to be no wider than a specified pixel width. ** Info ++++ +*** 'M-x info-apropos' now takes a prefix argument to search for regexps. + --- *** New command 'Info-goto-node-web' and key binding 'G'. This will take you to the gnu.org web server's version of the current @@ -777,6 +972,14 @@ phrase part will be automatically quoted if necessary. ** eww/shr +++ +*** New user option to automatically rename EWW buffers. +The 'eww-auto-rename-buffer' user option can be configured to rename +rendered web pages by using their title, URL, or a user-defined +function which returns a string. For the first two cases, the length +of the resulting name is controlled by 'eww-buffer-name-length'. By +default, no automatic renaming is performed. + ++++ *** New user option 'shr-allowed-images'. This complements 'shr-blocked-images', but allows specifying just the allowed images. @@ -795,6 +998,16 @@ the common "utm_" trackers from URLs. ** Gnus ++++ +*** Tool bar changes in Gnus/Message. +There were previously two styles of tool bars available in Gnus and +Message, referred to as 'gnus-summary-tool-bar-retro', +'gnus-group-tool-bar-retro' and 'message-tool-bar-retro', and +'gnus-summary-tool-bar-gnome', 'gnus-group-tool-bar-gnome' and +'message-tool-bar-gnome'. The "retro" tool bars have been removed (as +well as the icons used), and the "Gnome" tool bars are now the only +pre-defined toolbars. + --- *** Gnus now uses a variable-pitch font in the headers by default. To get the monospace font back, you can put something like the @@ -824,6 +1037,12 @@ representation as emojis. Configuration is very similar to the notmuch and namazu backends. It supports the unified search syntax. +--- +*** gnus-html-image-cache-ttl is now a seconds count. +Formerly it was a pair of numbers (A B) that represented 65536*A + B, +to cater to older Emacs implementations that lacked bignums. +The older form still works but is undocumented. + ** EIEIO +++ @@ -838,18 +1057,14 @@ M-x align' for it to work. This has now been changed. The default regexp for 'C-u M-x align-regexp' has also been changed to be easier for inexperienced users to use. -** eww - -+++ -*** New user option to automatically rename EWW buffers. -The 'eww-auto-rename-buffer' user option can be configured to rename -rendered web pages by using their title, URL, or a user-defined -function which returns a string. For the first two cases, the length -of the resulting name is controlled by 'eww-buffer-name-length'. By -default, no automatic renaming is performed. - ** Help +--- +*** New mode, 'emacs-news-view-mode', for viewing the NEWS file. +This mode is used by the 'C-h N' command, and adds buttons to manual +entries and symbol references. + +--- *** New user option 'help-link-key-to-documentation'. When this option is non-nil (which is the default), key bindings displayed in the "*Help*" buffer will be linked to the documentation @@ -886,9 +1101,11 @@ it with new 'term-{faint,italic,slow-blink,fast-blink}' faces. ** Xref ++++ *** 'project-find-file' and 'project-or-external-find-file' now accept a prefix argument which is interpreted to mean "include all files". ++++ *** 'project-kill-buffers' can display the list of buffers to kill. Customize the user option 'project-kill-buffers-display-buffer-list' to enable the display of the buffer list. @@ -898,14 +1115,19 @@ to enable the display of the buffer list. It is bound to 'C-M-,' and jumps to the location where 'xref-go-back' ('M-,', also known as 'xref-pop-marker-stack') was invoked previously. -*** 'xref-query-replace-in-results' does not prompt for FROM when -called without prefix argument, to make the most common case faster: -replacing entire matches. ++++ +*** 'xref-query-replace-in-results' prompting change. +This command no longer prompts for FROM when called without prefix +argument. This makes the most common case faster: 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 @@ -939,6 +1161,7 @@ The keybinding for 'image-transform-fit-to-width' is now 's i'. *** User option 'image-auto-resize' can now be set to 'fit-window'. This works like 'image-transform-fit-to-window'. +--- *** New user option 'image-auto-resize-max-scale-percent'. The new 'fit-window' option will never scale an image more than this much (in percent). It is nil by default, which means no limit. @@ -970,8 +1193,8 @@ user options that are no longer needed are now obsolete: *** Navigation and marking commands now work in image display buffer. The following new bindings have been added: - n / SPC image-dired-display-next-thumbnail-original - p / DEL image-dired-display-previous-thumbnail-original + n or SPC image-dired-display-next-thumbnail-original + p or DEL image-dired-display-previous-thumbnail-original m image-dired-mark-thumb-original-file d image-dired-flag-thumb-original-file u image-dired-unmark-thumb-original-file @@ -1058,6 +1281,7 @@ If non-nil, dragging file names with the mouse in a Dired buffer will initiate a drag-and-drop session allowing them to be opened in other programs. ++++ *** New user option 'dired-free-space'. Dired will now, by default, include the free space in the first line instead of having it on a separate line. To get the previous behavior @@ -1073,6 +1297,7 @@ the buffer will take you to that directory. ** Exif +--- *** New function 'exif-field'. This is a convenience function to extract the field data from 'exif-parse-file' and 'exif-parse-buffer'. @@ -1128,7 +1353,7 @@ will abbreviate the user's home directory, for example by abbreviating +++ *** New user option 'tramp-use-scp-direct-remote-copying'. 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' +hosts via a local copy in its temporary directory, but lets the 'scp' command do this job. +++ @@ -1152,6 +1377,7 @@ the Galeon web browser was released in September, 2008. ** Ruby Mode +--- *** New user option 'ruby-toggle-block-space-before-parameters'. ** Eshell @@ -1165,6 +1391,50 @@ support for pipelines which will move a lot of data. See section "Running Shell Pipelines Natively" in the Eshell manual, node "(eshell) Input/Output". ++++ +*** New module to help supplying absolute file names to remote commands. +After enabling the new 'eshell-elecslash' module, typing a forward +slash as the first character of a command line argument will +automatically insert the Tramp prefix. The automatic insertion +applies only when 'default-directory' is remote and the command is a +Lisp function. This frees you from having to keep track of whether +commands are Lisp function or external when supplying absolute file +name arguments. See "Electric forward slash" in the Eshell manual. + ++++ +*** Double-quoting an Eshell expansion now treats the result as a single string. +If an Eshell expansion like '$FOO' is surrounded by double quotes, the +result will always be a single string, no matter the type that would +otherwise be returned. + ++++ +*** Concatenating Eshell expansions now works more similarly to other shells. +When concatenating an Eshell expansion that returns a list, "adjacent" +elements of each operand are now concatenated together, +e.g. '$list("a" "b")c' returns '("a" "bc")'. See the "(eshell) +Expansion" node in the Eshell manual for more details. + ++++ +*** Eshell subcommands with multiline numeric output return lists of numbers. +If every line of the output of an Eshell subcommand like '${COMMAND}' +is numeric, the result will be a list of numbers (or a single number +if only one line of output). Previously, this only converted numbers +when there was a single line of output. + +--- +*** Built-in Eshell commands now follow POSIX/GNU argument syntax conventions. +Built-in commands in Eshell now accept command-line options with +values passed as a single token, such as '-oVALUE' or +'--option=VALUE'. New commands can take advantage of this with the +'eshell-eval-using-options' macro. See "Defining new built-in +commands" in the "(eshell) Built-ins" node of the Eshell manual. + +** Calc + ++++ +*** New user option 'calc-kill-line-numbering'. +This can be set to nil to exclude line numbering from kills and copies. + ** Miscellaneous +++ @@ -1176,7 +1446,7 @@ keyword-driven fontifications. *** 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' +using fonts of different sizes, and images. See the "(vtable) Top" manual for more details. --- @@ -1212,6 +1482,11 @@ remote host are shown. Alternatively, the user option Allows the creation of "functions with slots" or "function objects" via the macros 'oclosure-define' and 'oclosure-lambda'. +*** New generic function 'oclosure-interactive-form'. +Used by 'interactive-form' when called on an OClosure. +This allows specific OClosure types to compute their interactive specs +on demand rather than precompute them when created. + --- ** New theme 'leuven-dark'. This is a dark version of the 'leuven' theme. @@ -1247,6 +1522,7 @@ they will still be escaped, so the '.foo' symbol is still printed as 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 @@ -1360,8 +1636,74 @@ functions. * Lisp Changes in Emacs 29.1 +--- +** New macro 'with-buffer-unmodified-if-unchanged'. +If the buffer is marked as unmodified, and code does modifications +that, in total, means that the buffer is identical to the buffer +before, mark the buffer as unmodified again. + +--- +** New function 'malloc-trim'. +This function allows returning unused memory back to the operating +system, and is mainly meant as a debugging tool. It is currently +available only when Emacs was built with glibc as the C library. + +--- +** 'x-show-tip' no longer hard-codes a timeout default. +The new 'x-show-tooltip-timeout' variable allows the user to alter +this for packages that don't use 'tooltip-show', but instead calls the +lower level function directly. + ++++ +** New function 'window-max-characters-per-line'. + ++++ +** New function 'window-char-pixel-width'. + ++++ +** New function 'window-char-pixel-width'. + +--- +** New function 'current-cpu-time'. +It gives access to the CPU time used by the Emacs process, for +example for benchmarking purposes. + +--- +** New function 'string-edit'. +This is meant to be used when the user has to edit a (potentially) +long string. It pops you to a new buffer where you can edit the +string, and a callback is called when the user types 'C-c C-c'. + ++++ +** New function 'read-string-from-buffer'. +This is a modal version of 'string-edit', and can be used as an +alternative to 'read-string'. + ++++ +** The return value of 'clear-message-function' is not ignored anymore. +If the function returns 'dont-clear-message', then the message is not +cleared, with the assumption that the function cleared it itself. + ++++ +** The local variable section now supports defining fallback modes. +This was previously only available when using a property line (i.e., +putting the modes on the first line of a file). + ++++ +** New function 'flush-standard-output'. +This enables you do display incomplete lines from batch-based Emacs +scripts. + ++++ +** New convenience function 'buttonize-region'. +This works like 'buttonize', but for a region instead of a string. + +++ -** 'macroexp-let2*' can omit 'test' arg and use single-var bindings. +** 'macroexp-let2*' can omit TEST arg and use single-var bindings. + ++++ +** New macro-writing macros, 'cl-with-gensyms' and 'cl-once-only'. +See the "(cl) Macro-Writing Macros" manual section for descriptions. +++ ** New variable 'last-event-device' and new function 'device-class'. @@ -1388,8 +1730,9 @@ compliant. +++ ** New macro 'setopt'. -This is like 'setq', but uses 'customize-set-variable' to set the -variable(s). +This is like 'setq', but is meant to be used for user options instead +of plain variables, and +uses 'custom-set'/'set-default' to set them. +++ ** New utility predicate 'mode-line-window-selected-p'. @@ -1475,6 +1818,17 @@ them towards or away from each other. This hook is run before 'x-popup-menu' is about to display a deck-of-cards menu on screen. +** New function 'buffer-match-p'. +Check if a buffer satisfies some condition. Some examples for +conditions can be regular expressions that match a buffer name, a +cons-cell like '(major-mode . shell-mode)' that matches any buffer +where 'major-mode' is 'shell-mode' or a combined with a condition like +'(and "\\`\\*.+\\*\\'" (major-mode . special-mode))'. + +** New function 'match-buffers'. +Use 'buffer-match-p' to gather a list of buffers that match a +condition. + ** Text security and suspiciousness +++ @@ -1612,8 +1966,10 @@ It marks the image with the 'inhibit-isearch' text property, which inhibits 'isearch' matching the STRING parameter. --- -** New function 'replace-regexp-function'. -It can be used to implement own regexp syntax for search/replace. +** New variable 'replace-regexp-function'. +Function to call to convert the entered FROM string to an Emacs +regexp in 'query-replace' and similar commands. It can be used to +implement a different regexp syntax for search/replace. --- ** New variables to customize defaults of FROM for 'query-replace*' commands. @@ -1664,11 +2020,6 @@ dimensions. Specifying a cons as the FROM argument allows to start measuring text from a specified amount of pixels above or below a position. ---- -** 'eshell-eval-using-options' now follows POSIX/GNU argument syntax conventions. -Built-in commands in Eshell now accept command-line options with -values passed as a single token, such as '-oVALUE' or '--option=VALUE'. - ** XDG support --- @@ -1845,11 +2196,21 @@ For example, '(time-add nil '(1 . 1000))' no longer warns that the temporary transition aid for Emacs 27, has served its purpose. +++ +** 'encode-time' now also accepts a 6-element list with just time and date. +(encode-time (list SECOND MINUTE HOUR DAY MONTH YEAR)) is now short for +(encode-time (list SECOND MINUTE HOUR DAY MONTH YEAR nil -1 nil)). + ++++ ** 'date-to-time' now assumes earliest values if its argument lacks month, day, or time. For example, (date-to-time "2021-12-04") now assumes a time of 00:00 instead of signaling an error. +++ +** 'format-seconds' now allows suppressing zero-value trailing elements. +The new "%x" non-printing control character will suppress zero-value +elements that appear after "%x". + ++++ ** New events for taking advantage of touchscreen devices. The events 'touchscreen-begin, 'touchscreen-update', and 'touchscreen-end' have been added to take better advantage of @@ -1883,7 +2244,7 @@ translation. +++ ** 'shell-quote-argument' has a new optional parameter POSIX. This is useful when quoting shell arguments for a remote shell -invocation. Such shells are POSIX conform by default. +invocation. Such shells are POSIX conformant by default. +++ ** 'signal-process' now consults the list 'signal-process-functions'. @@ -1893,8 +2254,8 @@ asynchronous processes. The hitherto existing implementation has been moved to 'signal-default-interrupt-process'. +++ -** 'list-system-processes' returns remote process IDs now. -This happens, when the current buffer's 'default-directory' is +** 'list-system-processes' now returns remote process IDs. +This happens only when the current buffer's 'default-directory' is remote. In order to preserve the old behavior, apply (let ((default-directory temporary-file-directory)) @@ -1915,6 +2276,21 @@ to preserve the old behavior, apply ** MS-Windows +--- +*** Emacs now supports double-buffering on MS-Windows to reduce display flicker. +(This was supported on Free systems since Emacs 26.1.) + +To disable double-buffering (e.g., if it causes display problems), set +the frame parameter 'inhibit-double-buffering' to a non-nil value. +You can do that either by adding + + '(inhibit-double-buffering . t) + +to 'default-frame-alist', or by modifying the frame parameters of the +selected frame by evaluating + + (modify-frame-parameters nil '((inhibit-double-buffering . t))) + +++ *** Emacs now supports system dark mode. On Windows 10 (version 1809 and higher) and Windows 11, Emacs will now @@ -1940,6 +2316,11 @@ where those APIs are available. When 'w32-use-native-image-API' is non-nil, Emacs on MS-Windows now has built-in support for displaying BMP images. +** Cygwin + +--- +*** 'process-attributes' is now implemented. + ---------------------------------------------------------------------- This file is part of GNU Emacs. @@ -1961,5 +2342,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. Local variables: coding: utf-8 mode: outline +mode: emacs-news paragraph-separate: "[ ]*$" end: diff --git a/etc/NEWS.28 b/etc/NEWS.28 index 84041d79c20..995de8d3177 100644 --- a/etc/NEWS.28 +++ b/etc/NEWS.28 @@ -15,12 +15,6 @@ in older Emacs versions. You can narrow news to a specific version by calling 'view-emacs-news' with a prefix argument or by typing 'C-u C-h C-n'. -Temporary note: -+++ indicates that all relevant manuals in doc/ have been updated. ---- means no change in the manuals is needed. -When you add a new item, use the appropriate mark if you are sure it -applies, and please also update docstrings as needed. - * Installation Changes in Emacs 28.1 @@ -58,30 +52,25 @@ still be available when HarfBuzz is supported, but will not be used by default. We strongly recommend building with HarfBuzz support. 'x' is still a valid backend. ---- ** 'configure' now warns about building with libXft support. libXft is unmaintained, and causes a number of problems with modern fonts including but not limited to crashes; support for it may be removed in a future version of Emacs. Please consider using Cairo + HarfBuzz instead. ---- ** 'configure' now warns about not using HarfBuzz if using Cairo. We want to encourage people to use the most modern font features available, and this is the Cairo graphics library + HarfBuzz for font shaping, so 'configure' now recommends that combination. ---- ** Building without double buffering support. 'configure --with-xdbe=no' can now be used to disable double buffering at build time. ---- ** The configure option '--without-makeinfo' has been removed. This was only ever relevant when building from a repository checkout. This now requires makeinfo, which is part of the texinfo package. ---- ** New configure option '--disable-year2038'. This causes Emacs to use only 32-bit time_t on platforms that have both 32- and 64-bit time_t. This may help when linking Emacs with a @@ -90,16 +79,13 @@ currently affects only 32-bit ARM and x86 running GNU/Linux with glibc 2.34 and later. Emacs now defaults to 64-bit time_t on these platforms. ---- ** Support for building with '-fcheck-pointer-bounds' has been removed. GCC has withdrawn the '-fcheck-pointer-bounds' option and support for its implementation has been removed from the Linux kernel. ---- ** The ftx font backend driver has been removed. It was declared obsolete in Emacs 27.1. ---- ** Emacs no longer supports old OpenBSD systems. OpenBSD 5.3 and older releases are no longer supported, as they lack proper pty support that Emacs needs. @@ -107,13 +93,11 @@ proper pty support that Emacs needs. * Startup Changes in Emacs 28.1 ---- ** In GTK builds, Emacs now supports startup notification. This means that Emacs won't steal keyboard focus upon startup (when started via the Desktop) if the user is typing into another application. ---- ** Errors in 'kill-emacs-hook' no longer prevent Emacs from shutting down. If a function in that hook signals an error in an interactive Emacs, the user will be prompted on whether to continue. If the user doesn't @@ -136,7 +120,6 @@ lacks the terminfo database, you can instruct Emacs to support 24-bit true color by setting 'COLORTERM=truecolor' in the environment. This is useful on systems such as FreeBSD which ships only with "etc/termcap". ---- ** File names given on the command line are now be pushed onto history. The file names will be pushed onto 'file-name-history', like the names of files visited via 'C-x C-f' and other commands. @@ -144,10 +127,8 @@ of files visited via 'C-x C-f' and other commands. * Changes in Emacs 28.1 ---- ** Emacs now supports Unicode Standard version 14.0. -+++ ** Improved support for Emoji. On capable systems, Emacs now correctly displays Emoji and Emoji sequences by default, provided that a suitable font is available to @@ -171,20 +152,17 @@ the above example. (Previously, the Emoji characters were assigned to the 'symbol' script, together with other symbol and punctuation characters.) -+++ ** 'glyphless-char-display-control' now applies to Variation Selectors. VS-1 through VS-16 are now displayed as 'thin-space' by default when not composed with previous characters (typically, as part of Emoji sequences). -+++ ** New command 'execute-extended-command-for-buffer'. This new command, bound to 'M-S-x', works like 'execute-extended-command', but limits the set of commands to the commands that have been determined to be particularly useful with the current mode. -+++ ** New user option 'read-extended-command-predicate'. This user option controls how 'M-x' performs completion of commands when you type 'TAB'. By default, any command that matches what you have @@ -193,36 +171,30 @@ option to exclude commands that are not applicable to the current buffer's major and minor modes, and respect the command's completion predicate (if any). -+++ ** Completion on 'M-x' shows key bindings for commands. When 'suggest-key-bindings' is non-nil (as it is by default), the completion list popped up by 'M-x' shows the key bindings for all the commands shown in the list of candidate completions that have a key binding. -+++ ** New user option 'completions-detailed'. When non-nil, some commands like 'describe-symbol' show more detailed completions with more information in completion prefix and suffix. The default is nil. ---- ** 'C-s' in 'M-x' now once again searches over completions. In Emacs 23, typing 'M-x' ('read-extended-command') and then 'C-s' (to do an interactive search) would search over possible completions. This was lost in Emacs 24, but is now back again. -+++ ** User option 'completions-format' supports a new value 'one-column'. -+++ ** New system for displaying documentation for groups of functions. This can either be used by saying 'M-x shortdoc-display-group' and choosing a group, or clicking a button in the "*Help*" buffers when looking at the doc string of a function that belongs to one of these groups. -+++ ** New minor mode 'context-menu-mode' for context menus popped by 'mouse-3'. When this mode is enabled, clicking 'down-mouse-3' (usually, the right mouse button) anywhere in the buffer pops up a menu whose @@ -232,7 +204,6 @@ by customizing the user option 'context-menu-functions'. You can also invoke the context menu by pressing 'S-<F10>' or, on macOS, by clicking 'C-down-mouse-1'. -+++ ** A new keymap for buffer actions has been added. The 'C-x x' keymap now holds keystrokes for various buffer-oriented commands. The new keystrokes are 'C-x x g' ('revert-buffer-quick'), @@ -240,34 +211,29 @@ commands. The new keystrokes are 'C-x x g' ('revert-buffer-quick'), ('clone-buffer'), 'C-x x i' ('insert-buffer'), 'C-x x t' ('toggle-truncate-lines') and 'C-x x f' ('font-lock-update'). -+++ ** Modifiers now go outside angle brackets in pretty-printed key bindings. For example, 'RET' with Control and Meta modifiers is now shown as 'C-M-<return>' instead of '<C-M-return>'. Either variant can be used as input; functions such as 'kbd' and 'read-kbd-macro' accept both styles as equivalent (they have done so for a long time). ---- ** 'eval-expression' no longer signals an error on incomplete expressions. Previously, typing 'M-: ( RET' would result in Emacs saying "End of file during parsing" and dropping out of the minibuffer. The user would have to type 'M-: M-p' to edit and redo the expression. Now Emacs will echo the message and allow the user to continue editing. -+++ ** 'eval-last-sexp' now handles 'defvar'/'defcustom'/'defface' specially. This command would previously not redefine values defined by these forms, but this command has now been changed to work more like 'eval-defun', and reset the values as specified. ---- ** New user option 'use-short-answers'. When non-nil, the function 'y-or-n-p' is used instead of 'yes-or-no-p'. This eliminates the need to define an alias that maps one to another in the init file. The same user option also controls whether the function 'read-answer' accepts short answers. -+++ ** New user option 'kill-buffer-delete-auto-save-files'. If non-nil, killing a buffer that has an auto-save file will prompt the user for whether that auto-save file should be deleted. (Note @@ -277,37 +243,31 @@ unsaved changes, but this has apparently not worked for several decades, so the documented semantics of this variable has been changed to match the behavior.) -+++ ** New user option 'next-error-message-highlight'. In addition to a fringe arrow, 'next-error' error may now optionally highlight the current error message in the 'next-error' buffer. This user option can be also customized to keep highlighting on all visited errors, so you can have an overview what errors were already visited. ---- ** New choice 'next-error-quit-window' for 'next-error-found-function'. When 'next-error-found-function' is customized to 'next-error-quit-window', then typing the numeric prefix argument 0 before the command 'next-error' will quit the source window after visiting the next occurrence. -+++ ** New user option 'file-preserve-symlinks-on-save'. This controls what Emacs does when saving buffers that visit files via symbolic links, and 'file-precious-flag' is non-nil. -+++ ** New user option 'copy-directory-create-symlink'. If non-nil, will make 'copy-directory' (when used on a symbolic link) copy the link instead of following the link. The default is nil, so the default behavior is unchanged. -+++ ** New user option 'ignored-local-variable-values'. This is the opposite of 'safe-local-variable-values' -- it's an alist of variable-value pairs that are to be ignored when reading a local-variables section of a file. ---- ** Specific warnings can now be disabled from the warning buffer. When a warning is displayed to the user, the resulting buffer now has buttons which allow making permanent changes to the treatment of that @@ -315,21 +275,17 @@ warning. Automatic showing of the warning can be disabled (although it is still logged to the "*Messages*" buffer), or the warning can be disabled entirely. -+++ ** ".dir-locals.el" now supports setting 'auto-mode-alist'. The new 'auto-mode-alist' specification in ".dir-locals.el" files can now be used to override the global 'auto-mode-alist' in the current directory tree. ---- ** User option 'uniquify-buffer-name-style' can now be a function. This user option can be one of the predefined styles or a function to personalize the uniquified buffer name. ---- ** 'remove-hook' is now an interactive command. ---- ** 'expand-file-name' now checks for null bytes in filenames. The function will now check for null bytes in both NAME and DEFAULT-DIRECTORY arguments, as well as in the 'default-directory' @@ -339,22 +295,18 @@ This means that practically all file-related operations will now check file names for null bytes, thus avoiding subtle bugs with silently using only the part of file name up to the first null byte. ---- ** Frames -+++ *** The key prefix 'C-x 5 5' displays next command buffer in a new frame. It's bound to the command 'other-frame-prefix' that requests the buffer of the next command to be displayed in a new frame. -+++ *** New command 'clone-frame' (bound to 'C-x 5 c'). This is like 'C-x 5 2', but uses the window configuration and frame parameters of the current frame instead of 'default-frame-alist'. When called interactively with a prefix arg, the window configuration is not cloned. ---- *** Default values of 'frame-title-format' and 'icon-title-format' have changed. These variables are used to display the title bar of visible frames and the title bar of an iconified frame. They now show the name of @@ -365,68 +317,56 @@ your init file: (setq frame-title-format '(multiple-frames "%b" ("" invocation-name "@" system-name))) -+++ *** New frame parameter 'drag-with-tab-line'. This parameter, similar to 'drag-with-header-line', allows moving frames by dragging the tab lines of their topmost windows with the mouse. -+++ *** New optional behavior of 'delete-other-frames'. When invoked with a prefix argument, 'delete-other-frames' now iconifies frames, rather than deleting them. ---- *** Commands 'set-frame-width' and 'set-frame-height' now prompt for values. These commands now prompt for the value via the minibuffer, instead of requiring the user to specify the value via the prefix argument. ** Windows -+++ *** The key prefix 'C-x 4 1' displays next command buffer in the same window. It's bound to the command 'same-window-prefix' that requests the buffer of the next command to be displayed in the same window. -+++ *** The key prefix 'C-x 4 4' displays next command buffer in a new window. It's bound to the command 'other-window-prefix' that requests the buffer of the next command to be displayed in a new window. -+++ *** New command 'recenter-other-window', bound to 'S-M-C-l'. Like 'recenter-top-bottom', but acting on the other window. -+++ *** New user option 'delete-window-choose-selected'. This allows specifying how Emacs chooses which window will be the frame's selected window after the currently selected window is deleted. -+++ *** New argument NO-OTHER for some window functions. 'get-lru-window', 'get-mru-window' and 'get-largest-window' now accept a new optional argument NO-OTHER which, if non-nil, avoids returning a window whose 'no-other-window' parameter is non-nil. -+++ *** New 'display-buffer' function 'display-buffer-use-least-recent-window'. This is like 'display-buffer-use-some-window', but won't reuse the current window, and when called repeatedly will try not to reuse a previously selected window. -+++ *** New function 'window-bump-use-time'. This updates the use time of a window. ** Minibuffer -+++ *** Minibuffer scrolling is now conservative by default. This is controlled by the new variable 'scroll-minibuffer-conservatively'. It is t by default; setting it to nil will cause scrolling in the minibuffer obey the value of 'scroll-conservatively'. -+++ *** Improved handling of minibuffers on switching frames. By default, when you switch to another frame, an active minibuffer now moves to the newly selected frame. Nevertheless, the effect of what @@ -439,14 +379,12 @@ behavior, which mixed these two, can be approximated by customizing 'minibuffer-follows-selected-frame' to a value which is neither nil nor t. -+++ *** New user option 'read-minibuffer-restore-windows'. When customized to nil, it uses 'minibuffer-restore-windows' in 'minibuffer-exit-hook' to remove only the window showing the "*Completions*" buffer, but keeps all other windows created while the minibuffer was active. ---- *** New variable 'redisplay-adhoc-scroll-in-resize-mini-windows'. Customizing it to nil will disable the ad-hoc auto-scrolling of minibuffer text shown in mini-windows when resizing those windows. @@ -457,13 +395,11 @@ cases anyway. ** Mode Line -+++ *** New user option 'mode-line-compact'. If non-nil, repeating spaces are compressed into a single space. If 'long', this is only done when the mode line is longer than the current window width (in columns). -+++ *** New user options to control format of line/column numbers in the mode line. 'mode-line-position-line-format' is the line number format (when 'line-number-mode' is on), 'mode-line-position-column-format' is @@ -473,16 +409,13 @@ both modes are on). ** Tab Bars and Tab Lines -+++ *** The prefix key 'C-x t t' can be used to display a buffer in a new tab. Typing 'C-x t t' before a command will cause the buffer shown by that command to be displayed in a new tab. 'C-x t t' is bound to the command 'other-tab-prefix'. -+++ *** New command 'C-x t C-r' to open file read-only in the other tab. -+++ *** The tab bar now supports more mouse commands. Clicking 'mouse-2' closes the tab, 'mouse-3' displays the context menu with items that operate on the clicked tab. Dragging the tab with @@ -490,20 +423,17 @@ with items that operate on the clicked tab. Dragging the tab with scrolling switches to the previous/next tab, and holding the Shift key during scrolling moves the tab to the left/right. -+++ *** Frame-specific appearance of the tab bar when 'tab-bar-show' is a number. When 'tab-bar-show' is a number, the tab bar on different frames can be shown or hidden independently, as determined by the number of tabs on each frame compared to the numerical value of 'tab-bar-show'. -+++ *** New command 'toggle-frame-tab-bar'. It can be used to enable/disable the tab bar on the currently selected frame regardless of the values of 'tab-bar-mode' and 'tab-bar-show'. This allows enabling/disabling the tab bar independently on different frames. -+++ *** New user option 'tab-bar-format' defines a list of tab bar items. When it contains 'tab-bar-format-global' (possibly appended after 'tab-bar-format-align-right'), then after enabling 'display-time-mode' @@ -512,7 +442,6 @@ aligned to the right on the tab bar instead of on the mode line. When 'tab-bar-format-tabs' is replaced with 'tab-bar-format-tabs-groups', the tab bar displays tab groups. -+++ *** New optional key binding for 'tab-last'. If you customize the user option 'tab-bar-select-tab-modifiers' to allow selecting tabs using their index numbers, the '<MODIFIER>-9' key @@ -522,20 +451,16 @@ is any of the modifiers in the list that is the value of which count from the last tab: 1 is the last tab, 2 the one before that, etc. ---- *** New command 'tab-duplicate' bound to 'C-x t n'. ---- *** 'C-x t N' creates a new tab at the specified absolute position. The position is provided as prefix arg, and specifies an index that starts at 1. Negative values count from the end of the tab bar. ---- *** 'C-x t M' moves the current tab to the specified absolute position. The position is provided as prefix arg, whose interpretation is as in 'C-x t N'. ---- *** 'C-x t G' assigns a tab to a named group of tabs. 'tab-close-group' closes all tabs that belong to the selected group. The user option 'tab-bar-new-tab-group' defines the default group of @@ -543,18 +468,14 @@ new tabs. After customizing 'tab-bar-tab-post-change-group-functions' to 'tab-bar-move-tab-to-group', changing the group of a tab will also move it closer to other tabs in the same group. ---- *** New user option 'tab-bar-tab-name-format-function'. ---- *** New user option 'tab-line-tab-name-format-function'. ---- *** The tabs in the tab line can now be scrolled using horizontal scroll. If your mouse or trackpad supports it, you can now scroll tabs when the mouse pointer is in the tab line by scrolling left or right. ---- *** New tab-line faces and user options. The face 'tab-line-tab-special' is used for tabs whose buffers are special, i.e. buffers that don't visit a file. The face @@ -569,17 +490,14 @@ in other ways. ** Mouse wheel ---- *** Mouse wheel scrolling now defaults to one line at a time. ---- *** Mouse wheel scrolling now works on more parts of frame's display. When using 'mouse-wheel-mode', the mouse wheel will now scroll also when the mouse cursor is on the scroll bars, fringes, margins, header line, and mode line. ('mouse-wheel-mode' is enabled by default on most graphical displays.) -+++ *** Mouse wheel scrolling with Shift modifier now scrolls horizontally. This works in text buffers and over images. Typing a numeric prefix arg (e.g. 'M-5') before starting horizontal scrolling changes its step value. @@ -587,10 +505,8 @@ The value is saved in the user option 'mouse-wheel-scroll-amount-horizontal'. ** Customize ---- *** Customize buffers can now be reverted with 'C-x x g'. ---- *** Most customize commands now hide obsolete user options. Obsolete user options are no longer shown in the listings produced by the commands 'customize', 'customize-group', 'customize-apropos' and @@ -599,35 +515,28 @@ the commands 'customize', 'customize-group', 'customize-apropos' and To customize obsolete user options, use 'customize-option' or 'customize-saved'. ---- *** New SVG icons for checkboxes and arrows. They will be used automatically instead of the old icons. If Emacs is built without SVG support, the old icons will be used instead. ** Help ---- *** The order of things displayed in the "*Help*" buffer has been changed. The indented "administrative" block (containing the "probably introduced" and "other relevant functions" (and similar things) has been moved to after the doc string. -+++ *** New command 'describe-command' shows help for a command. This can be used instead of 'describe-function' for interactive commands and is globally bound to 'C-h x'. -+++ *** New command 'describe-keymap' describes keybindings in a keymap. ---- *** New command 'apropos-function'. This works like 'C-u M-x apropos-command' but is more discoverable. ---- *** New keybinding 'C-h R' prompts for an Info manual and displays it. ---- *** Keybindings in 'help-mode' use the new 'help-key-binding' face. This face is added by 'substitute-command-keys' to any "\[command]" substitution. The return value of that function should consequently @@ -638,17 +547,14 @@ with the new optional argument NO-FACE non-nil. Note that the new face will also be used in tooltips. When using the GTK toolkit, this is only true if 'x-gtk-use-system-tooltips' is t. -+++ *** New user option 'help-enable-symbol-autoload'. If non-nil, displaying help for an autoloaded function whose 'autoload' form provides no documentation string will try to load the file it's from. This will give more extensive help for such functions. ---- *** The 'help-for-help' ('C-h C-h') screen has been redesigned. -+++ *** 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') @@ -656,79 +562,65 @@ 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. ---- *** New user option 'describe-bindings-outline'. It enables outlines in the output buffer of 'describe-bindings' that 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 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. Now clicking on the link to find the definition of functions generated by 'cl-defstruct', or variables generated by 'define-derived-mode', for example, will go to the exact place where they are defined. ---- *** New commands 'apropos-next-symbol' and 'apropos-previous-symbol'. These new navigation commands are bound to 'n' and 'p' in 'apropos-mode'. ---- *** The command 'view-lossage' can now be invoked from the menu bar. The menu bar "Help" menu now has a "Show Recent Inputs" item under the "Describe" sub-menu. -+++ *** New command 'lossage-size'. It allows users to change the maximum number of keystrokes and commands recorded for the purpose of 'view-lossage'. ---- *** Closing the "*Help*" buffer from the toolbar now buries the buffer. In previous Emacs versions, the "*Help*" buffer was killed instead when clicking the "X" icon in the tool bar. ---- *** 'g' ('revert-buffer') in 'help-mode' no longer requires confirmation. ** File Locks -+++ *** New user option 'lock-file-name-transforms'. This option allows controlling where lock files are written. It uses the same syntax as 'auto-save-file-name-transforms'. -+++ *** New user option 'remote-file-name-inhibit-locks'. When non-nil, this option suppresses lock files for remote files. Default is nil. -+++ *** New minor mode 'lock-file-mode'. This command, called interactively, toggles the local value of 'create-lockfiles' in the current buffer. ** Emacs Server -+++ *** New user option 'server-client-instructions'. When emacsclient connects, Emacs will (by default) output a message about how to exit the client frame. If 'server-client-instructions' is set to nil, this message is inhibited. -+++ *** New command 'server-edit-abort'. This command (not bound to any key by default) can be used to abort an edit instead of marking it as "Done" (which the 'C-x #' command does). The 'emacsclient' program exits with an abnormal status as result of this command. -+++ *** New desktop integration for connecting to the server. If your operating system's desktop environment is freedesktop.org-compatible (which is true of most GNU/Linux and other @@ -739,25 +631,20 @@ running. ** Miscellaneous -+++ *** New command 'font-lock-update', bound to 'C-x x f'. This command updates the syntax highlighting in this buffer. -+++ *** New command 'memory-report'. This command opens a new buffer called "*Memory Report*" and gives a summary of where Emacs is using memory currently. -+++ *** New command 'submit-emacs-patch'. This works like 'report-emacs-bug', but is more geared towards sending patches to the Emacs issue tracker. ---- *** New face 'apropos-button'. Applies to buttons that indicate a face. -+++ *** New face 'font-lock-doc-markup-face'. Intended for documentation mark-up syntax and tags inside text that uses 'font-lock-doc-face', which it should appropriately stand out @@ -766,41 +653,34 @@ documentation comments in program source code by language-specific modes, for mark-up conventions like Haddock, Javadoc or Doxygen. By default this face inherits from 'font-lock-constant-face'. -+++ *** New face box style 'flat-button'. This is a plain 2D button, but uses the background color instead of the foreground color. ---- *** New faces 'shortdoc-heading' and 'shortdoc-section'. Applied to shortdoc headings and sections. ---- *** New face 'separator-line'. This is used by 'make-separator-line' (see below). -+++ *** 'redisplay-skip-fontification-on-input' helps Emacs keep up with fast input. This is another attempt to solve the problem of handling high key repeat rate and other "slow scrolling" situations. It is hoped it behaves better than 'fast-but-imprecise-scrolling' and 'jit-lock-defer-time'. It is not enabled by default. ---- *** Obsolete aliases are no longer hidden from command completion. Completion of command names now considers obsolete aliases as candidates, if they were marked obsolete in the current major version of Emacs. Invoking a command via an obsolete alias now mentions the obsolescence fact and shows the new name of the command. -+++ *** Support for '(box . SIZE)' 'cursor-type'. By default, 'box' cursor always has a filled box shape. But if you specify 'cursor-type' to be '(box . SIZE)', the cursor becomes a hollow box if the point is on an image larger than SIZE pixels in any dimension. -+++ *** The user can now customize how "default" values are prompted for. The new utility function 'format-prompt' has been added which uses the new 'minibuffer-default-prompt-format' user option to format "default" @@ -810,7 +690,6 @@ number [10]", or not have the default displayed at all, like "Enter a number". (This only affects callers that were altered to use 'format-prompt'.) ---- *** New help window when Emacs prompts before opening a large file. Commands like 'find-file' or 'visit-tags-table' ask to visit a file normally or literally when the file is larger than a certain size (by @@ -818,20 +697,17 @@ default, 9.5 MiB). Press '?' or 'C-h' in that prompt to read more about the different options to visit a file, how you can disable the prompt, and how you can tweak the file size threshold. -+++ *** Emacs now defaults to UTF-8 instead of ISO-8859-1. This is only for the default, where the user has set no 'LANG' (or similar) variable or environment. This change should lead to no user-visible changes for normal usage. ---- *** 'global-display-fill-column-indicator-mode' skips some buffers. By default, turning on 'global-display-fill-column-indicator-mode' doesn't turn on 'display-fill-column-indicator-mode' in special-mode buffers. This can be controlled by customizing the user option 'global-display-fill-column-indicator-modes'. -+++ *** 'nobreak-char-display' now also affects all non-ASCII space characters. Previously, this was limited only to 'NO-BREAK SPACE' and hyphen characters. Now it also covers the rest of the non-ASCII Unicode @@ -840,7 +716,6 @@ non-ASCII characters are displayed as themselves when 'nobreak-char-display' is t, i.e. they are not replaced on display with the ASCII space and hyphen characters. ---- *** New backward compatibility variable 'nobreak-char-ascii-display'. This variable is nil by default, and non-ASCII space and hyphen characters are displayed as themselves, even if 'nobreak-char-display' @@ -854,7 +729,6 @@ t. You may need this on text-mode terminals that produce messed up display when non-ASCII spaces and hyphens are written to the display. (This variable is only effective when 'nobreak-char-display' is t.) -+++ *** Improved support for terminal emulators that encode the Meta flag. Some terminal emulators set the 8th bit of Meta characters, and then encode the resulting character code as if it were non-ASCII character @@ -865,7 +739,6 @@ Meta characters to Emacs, e.g., send "ESC x" when the user types emulators by using the new input-meta-mode with the special value 'encoded' with these terminal emulators. ---- *** 'auto-composition-mode' can now be selectively disabled on some TTYs. Some text-mode terminals produce display glitches trying to compose characters. The 'auto-composition-mode' can now have a string value @@ -874,14 +747,12 @@ function compares equal with that string, automatic composition will be disabled in windows shown on that terminal. The Linux terminal sets this up by default. ---- *** Support for the 'strike-through' face attribute on TTY frames. If your terminal's termcap or terminfo database entry has the 'smxx' capability defined, Emacs will now emit the prescribed escape sequences necessary to render faces with the 'strike-through' attribute on TTY frames. ---- *** TTY menu navigation is now supported in 'xterm-mouse-mode'. TTY menus support mouse navigation and selection when 'xterm-mouse-mode' is active. When run on a terminal, clicking on the menu bar with the @@ -889,19 +760,15 @@ mouse now pops up a TTY menu by default instead of running the command 'tmm-menubar'. To restore the old behavior, set the user option 'tty-menu-open-use-tmm' to non-nil. ---- *** 'M-x report-emacs-bug' will no longer include "Recent messages" section. These were taken from the "*Messages*" buffer, and may inadvertently leak information from the reporting user. ---- *** 'C-u M-x dig' will now prompt for a query type to use. ---- *** Rudimentary support for the 'st' terminal emulator. Emacs now supports 256 color display on the 'st' terminal emulator. -+++ *** Update IRC-related references to point to Libera.Chat. The Free Software Foundation and the GNU Project have moved their official IRC channels from the Freenode network to Libera.Chat. For the @@ -921,12 +788,10 @@ https://lists.gnu.org/archive/html/info-gnu-emacs/2021-06/msg00000.html * Incompatible Editing Changes in Emacs 28.1 ---- ** 'toggle-truncate-lines' now disables 'visual-line-mode'. This is for symmetry with 'visual-line-mode', which disables 'truncate-lines'. ---- ** 'electric-indent-mode' now also indents inside strings and comments. (This only happens when indentation function also supports this.) @@ -935,7 +800,6 @@ To recover the previous behavior you can use: (add-hook 'electric-indent-functions (lambda (_) (if (nth 8 (syntax-ppss)) 'no-indent))) ---- ** The 'M-o' ('facemenu-keymap') global binding has been removed. To restore the old binding, say something like: @@ -947,7 +811,6 @@ To restore the old binding, say something like: The last two lines are not strictly necessary if you don't care about having those two commands on the 'M-o' keymap; see the next section. ---- ** The 'M-o M-s' and 'M-o M-S' global bindings have been removed. Use 'M-x center-line' and 'M-x center-paragraph' instead. See the previous section for how to get back the old bindings. Alternatively, @@ -957,12 +820,10 @@ had before, you can add the following to your init file: (define-key global-map "\M-o\M-s" 'center-line) (define-key global-map "\M-o\M-S" 'center-paragraph) ---- ** The 'M-o M-o' global binding has been removed. Use 'M-x font-lock-fontify-block' instead, or the new 'C-x x f' command, which updates the syntax highlighting in the current buffer. ---- ** The escape sequence '\e[29~' in Xterm is now mapped to 'menu'. Xterm sends this sequence for both 'F16' and 'Menu' keys It used to be mapped to 'print' but we couldn't find a terminal @@ -970,26 +831,21 @@ that uses this sequence for any kind of 'Print' key. This makes the Menu key (see https://en.wikipedia.org/wiki/Menu_key) work for 'context-menu-mode' in Xterm. ---- ** New user option 'xterm-store-paste-on-kill-ring'. If non-nil (the default), Emacs pushes pasted text onto the kill ring (if using an xterm-like terminal that supports bracketed paste). Setting this to nil inhibits that. ---- ** 'vc-print-branch-log' shows the change log from its root directory. It previously used to use the default directory. ---- ** 'project-shell' and 'shell' now use 'pop-to-buffer-same-window'. 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 Isearch, since the latter uses 'M-s' as a prefix key of the search prefix map. ---- ** In 'f90-mode', the backslash character ('\') no longer escapes. For about a decade, the backslash character has no longer had a special escape syntax in Fortran F90. To get the old behavior back, @@ -997,7 +853,6 @@ say something like: (modify-syntax-entry ?\\ "\\" f90-mode-syntax-table) -+++ ** Setting 'fill-column' to nil is obsolete. This undocumented use of 'fill-column' is now obsolete. To disable auto filling, turn off 'auto-fill-mode' instead. @@ -1012,7 +867,6 @@ file: ** Input methods -+++ *** Emacs now supports "transient" input methods. A transient input method is enabled for inserting a single character, and is then automatically disabled. 'C-x \' temporarily enables the @@ -1024,33 +878,27 @@ character '½', and disable the 'compose' input method afterwards. You can use 'C-x \' in incremental search to insert a single character to the search string. ---- *** New input method 'compose' based on X Multi_key sequences. ---- *** New input method 'iso-transl' with the same keys as 'C-x 8'. After selecting it as a transient input method with 'C-u C-x \ iso-transl RET', it supports the same key sequences as 'C-x 8', so e.g. like 'C-x 8 [' inserts a left single quotation mark, 'C-x \ [' does the same. ---- *** New user option 'read-char-by-name-sort'. It defines the sorting order of characters for completion of 'C-x 8 RET TAB' and can be customized to sort them by codepoints instead of character names. Additionally, you can group characters by Unicode blocks after customizing 'completions-group' and 'completions-group-sort'. ---- *** Improved language transliteration in Malayalam input methods. Added a new Mozhi scheme. The inapplicable ITRANS scheme is now deprecated. Errors in the Inscript method were corrected. ---- *** New input method 'cham'. There's also a Cham greeting in "etc/HELLO". ---- *** New input methods for Lakota language orthographies. Two orthographies are represented here, the Suggested Lakota Orthography and what is known as the White Hat Orthography. Input @@ -1058,7 +906,6 @@ methods 'lakota-slo-prefix', 'lakota-slo-postfix', and 'lakota-white-hat-postfix' have been added. There is also a Lakota greeting in "etc/HELLO". -+++ ** Standalone 'M-y' allows interactive selection from previous kills. 'M-y' can now be typed after a command that is not a yank command. When invoked like that, it prompts in the minibuffer for one of the @@ -1068,14 +915,12 @@ in Isearch can be invoked if you bind 'C-s M-y' to the command 'isearch-yank-pop'. When the user option 'yank-from-kill-ring-rotate' is nil the kill ring is not rotated after 'yank-from-kill-ring'. -+++ ** New user option 'word-wrap-by-category'. When word-wrap is enabled, and this option is non-nil, that allows Emacs to break lines after more characters than just whitespace characters. In particular, this significantly improves word-wrapping for CJK text mixed with Latin text. -+++ ** New command 'undo-redo'. It undoes previous undo commands, but doesn't record itself as an undoable command. It is bound to 'C-?' and 'C-M-_', the first binding @@ -1084,43 +929,35 @@ works well in graphical mode, and the second one is easy to hit on tty. For full conventional undo/redo behavior, you can also customize the user option 'undo-no-redo' to t. -+++ ** New commands 'copy-matching-lines' and 'kill-matching-lines'. These commands are similar to the command 'flush-lines', but add the matching lines to the kill ring as a single string, including the newlines that separate the lines. -+++ ** New user option 'kill-transform-function'. This can be used to transform (and suppress) strings from entering the kill ring. -+++ ** 'save-interprogram-paste-before-kill' can now be a number. In that case, it's interpreted as a limit on the size of the clipboard data that will be saved to the 'kill-ring' prior to killing text: if the size of the clipboard data is greater than or equal to the limit, it will not be saved. -+++ ** New user option 'tab-first-completion'. If 'tab-always-indent' is 'complete', this new user option can be used to further tweak whether to complete or indent. ---- ** 'indent-tabs-mode' is now a global minor mode instead of just a variable. -+++ ** New choice 'permanent' for 'shift-select-mode'. When the mark was activated by shifted motion keys, non-shifted motion keys don't deactivate the mark after customizing 'shift-select-mode' to 'permanent'. Similarly, the active mark will not be deactivated by typing shifted motion keys. -+++ ** The "Edit => Clear" menu item now obeys a rectangular region. -+++ ** New command 'revert-buffer-with-fine-grain'. Revert a buffer trying to be as non-destructive as possible, preserving markers, properties and overlays. The new variable @@ -1128,18 +965,15 @@ preserving markers, properties and overlays. The new variable number of seconds that 'revert-buffer-with-fine-grain' should spend trying to be non-destructive, with a default value of 2 seconds. -+++ ** New command 'revert-buffer-quick'. This is bound to 'C-x x g' and is like 'revert-buffer', but prompts less. -+++ ** New user option 'revert-buffer-quick-short-answers'. This controls how the new 'revert-buffer-quick' ('C-x x g') command prompts. A non-nil value will make it use 'y-or-n-p' rather than 'yes-or-no-p'. Defaults to nil. -+++ ** New user option 'query-about-changed-file'. If non-nil (the default), Emacs prompts as before when re-visiting a file that has changed externally after it was visited the first time. @@ -1147,30 +981,25 @@ If nil, Emacs does not prompt, but instead shows the buffer with its contents before the change, and provides instructions how to revert the buffer. ---- ** New value 'save-some-buffers-root' of 'save-some-buffers-default-predicate'. When using this predicate, only buffers under the current project root will be considered when saving buffers with 'save-some-buffers'. ---- ** New user option 'save-place-abbreviate-file-names'. This can simplify sharing the 'save-place-file' file across different hosts. ---- ** New user options 'copy-region-blink-delay' and 'delete-pair-blink-delay'. 'copy-region-blink-delay' specifies a delay to indicate the region copied by 'kill-ring-save'. 'delete-pair-blink-delay' specifies a delay to show the paired character to delete. ---- ** 'zap-up-to-char' now uses 'read-char-from-minibuffer'. This allows navigating through the history of characters that have been input. This is mostly useful for characters that have complex input methods where inputting the character again may involve many keystrokes. -+++ ** Input history for 'goto-line' can now be made local to every buffer. In any event, line numbers used with 'goto-line' are kept in their own history list. This should help make faster the process of finding @@ -1178,7 +1007,6 @@ line numbers that were previously jumped to. By default, all buffers share a single history list. To make every buffer have its own history list, customize the user option 'goto-line-history-local'. -+++ ** New command 'goto-line-relative' for use in a narrowed buffer. It moves point to the line relative to the accessible portion of the narrowed buffer. 'M-g M-g' in Info is rebound to this command. @@ -1186,7 +1014,6 @@ When 'widen-automatically' is non-nil, 'goto-line' widens the narrowed buffer to be able to move point to the inaccessible portion. 'goto-line-relative' is bound to 'C-x n g'. -+++ ** 'goto-char' prompts for the character position. When called interactively, 'goto-char' now offers the position at point as the default. @@ -1195,11 +1022,9 @@ point as the default. Set the user option 'auto-save-visited-mode' buffer-locally to nil to achieve that. -+++ ** New command 'kdb-macro-redisplay' to force redisplay in keyboard macros. This command is bound to 'C-x C-k d'. ---- ** 'blink-cursor-mode' is now enabled by default regardless of the UI. It used to be enabled when Emacs is started in GUI mode but not when started in text mode. The cursor still only actually blinks in GUI frames. @@ -1208,7 +1033,6 @@ in text mode. The cursor still only actually blinks in GUI frames. To go back to the previous behavior, customize the user option of the same name to nil. -+++ ** New minor mode 'show-paren-local-mode'. It serves as a local counterpart for 'show-paren-mode', allowing you to toggle it separately in different buffers. To use it only in @@ -1221,7 +1045,6 @@ programming modes, for example, add the following to your init file: ** Isearch and Replace -+++ *** Interactive regular expression search now uses faces for sub-groups. E.g., 'C-M-s foo-\([0-9]+\)' will now use the 'isearch-group-1' face on the part of the regexp that matches the sub-expression "[0-9]+". @@ -1233,12 +1056,10 @@ This is controlled by the 'search-highlight-submatches' user option. This feature is available only on terminals that have enough colors to distinguish between sub-expression highlighting. -+++ *** Interactive regular expression replace now uses faces for sub-groups. Like 'search-highlight-submatches', this is controlled by the new user option 'query-replace-highlight-submatches'. -+++ *** New key 'M-s M-.' starts isearch looking for the thing at point. This key is bound to the new command 'isearch-forward-thing-at-point'. The new user option 'isearch-forward-thing-at-point' defines @@ -1246,20 +1067,17 @@ a list of symbols to try to get the "thing" at point. By default, the first element of the list is 'region' that tries to yank the currently active region to the search string. -+++ *** New user option 'isearch-wrap-pause' defines how to wrap the search. There are choices to disable wrapping completely and to wrap immediately. When wrapping immediately, it consistently handles the numeric arguments of 'C-s' ('isearch-repeat-forward') and 'C-r' ('isearch-repeat-backward'), continuing with the remaining count after wrapping. -+++ *** New user option 'isearch-repeat-on-direction-change'. When this option is set, direction changes in Isearch move to another search match, if there is one, instead of moving point to the other 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 @@ -1271,14 +1089,12 @@ 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. -+++ *** New user option 'lazy-highlight-no-delay-length'. Lazy highlighting of matches in Isearch now starts immediately if the search string is at least this long. 'lazy-highlight-initial-delay' still applies for shorter search strings, which avoids flicker in the search buffer due to too many matches being highlighted. -+++ *** The default 'search-whitespace-regexp' value has changed. This used to be "\\s-+", which meant that it was mode-dependent whether newlines were included in the whitespace set. This has now been @@ -1286,52 +1102,43 @@ changed to only match spaces and tab characters. ** Dired -+++ *** New user option 'dired-kill-when-opening-new-dired-buffer'. If non-nil, Dired will kill the current buffer when selecting a new 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. ---- *** Behavior change on 'dired-clean-confirm-killing-deleted-buffers'. Previously, if 'dired-clean-up-buffers-too' was non-nil, and 'dired-clean-confirm-killing-deleted-buffers' was nil, the buffers wouldn't be killed. This combination will now kill the buffers. -+++ *** New user option 'dired-switches-in-mode-line'. This user option controls how 'ls' switches are displayed in the mode line, and allows truncating them (to preserve space on the mode line) or showing them literally, either instead of, or in addition to, displaying "by name" or "by date" sort order. -+++ *** New user option 'dired-compress-directory-default-suffix'. This user option controls the default suffix for compressing a directory. If it's nil, ".tar.gz" will be used. Refer to 'dired-compress-files-alist' for a list of supported suffixes. -+++ *** New user option 'dired-compress-file-default-suffix'. This user option controls the default suffix for compressing files. If it's nil, ".gz" will be used. Refer to 'dired-compress-file-alist' for a list of supported suffixes. ---- *** Broken and circular links are shown with the 'dired-broken-symlink' face. ---- *** '=' ('dired-diff') will now put all backup files into the 'M-n' history. When using '=' on a file with backup files, the default file to use for diffing is the newest backup file. You can now use 'M-n' to quickly select a different backup file instead. -+++ *** New user option 'dired-maybe-use-globstar'. If set, enables globstar (recursive globbing) in shells that support this feature, but have it turned off by default. This allows producing @@ -1340,19 +1147,16 @@ subdirectories of a given directory. The new variable 'dired-enable-globstar-in-shell' lists which shells can have globstar enabled, and how to enable it. -+++ *** New user option 'dired-copy-dereference'. If set to non-nil, Dired will dereference symbolic links when copying. This can be switched off on a per-usage basis by providing 'dired-do-copy' with a 'C-u' prefix. ---- *** New user option 'dired-do-revert-buffer'. Non-nil reverts the destination Dired buffer after performing one of these operations: 'dired-do-copy', 'dired-do-rename', 'dired-do-symlink', 'dired-do-hardlink'. ---- *** New user option 'dired-mark-region'. This option affects all Dired commands that mark files. When non-nil and the region is active in Transient Mark mode, then Dired commands @@ -1360,12 +1164,10 @@ operate only on files in the active region. The values 'file' and 'line' of this user option define the details of marking the file at the end of the region. -+++ *** State changing VC operations are supported in Dired. These operations are supported on files and directories via the new command 'dired-vc-next-action'. -+++ *** 'dired-jump' and 'dired-jump-other-window' moved from 'dired-x' to 'dired'. The 'dired-jump' and 'dired-jump-other-window' commands have been moved from the 'dired-x' package to 'dired'. The user option @@ -1378,25 +1180,21 @@ keys, add the following to your init file: (global-set-key "\C-x\C-j" nil) (global-set-key "\C-x4\C-j" nil) ---- *** 'dired-query' now uses 'read-char-from-minibuffer'. Using it instead of 'read-char-choice' allows using 'C-x o' to switch to the help window displayed after typing 'C-h'. -+++ ** Emacs 28.1 comes with Org v9.5. See the file ORG-NEWS for user-visible changes in Org. ** Outline -+++ *** New commands to cycle heading visibility. Typing 'TAB' on a heading line cycles the current section between "hide all", "subheadings", and "show all" states. Typing 'S-TAB' anywhere in the buffer cycles the whole buffer between "only top-level headings", "all headings and subheadings", and "show all" states. -+++ *** New user option 'outline-minor-mode-cycle'. This user option customizes 'outline-minor-mode', with the difference that 'TAB' and 'S-TAB' on heading lines cycle heading visibility. @@ -1405,7 +1203,6 @@ Typing 'TAB' on a heading line cycles the current section between heading line cycles the whole buffer between "only top-level headings", "all headings and subheadings", and "show all" states. ---- *** New user option 'outline-minor-mode-highlight'. This user option customizes 'outline-minor-mode'. It puts highlighting on heading lines using standard outline faces. This @@ -1414,27 +1211,22 @@ major mode. ** Ispell -+++ *** 'ispell-comments-and-strings' now accepts START and END arguments. These arguments default to the active region when used interactively. -+++ *** New command 'ispell-comment-or-string-at-point'. ---- *** New user option 'ispell-help-timeout'. This controls how long the ispell help (on the '?' key) is displayed. ** Flyspell mode -+++ *** Corrections and actions menu can be optionally bound to 'mouse-3'. When Flyspell mode highlights a word as misspelled, you can click on it to display a menu of possible corrections and actions. You can now easily bind this menu to 'down-mouse-3' (usually the right mouse button) instead of 'mouse-2' (the default) by enabling 'context-menu-mode'. ---- *** The current dictionary is now displayed in the minor mode lighter. Clicking the dictionary name changes the current dictionary. @@ -1444,7 +1236,6 @@ Clicking the dictionary name changes the current dictionary. Thus, packages on NonGNU ELPA will appear by default in the list shown by 'list-packages'. ---- *** '/ s' ('package-menu-filter-by-status') changed parameter handling. The command was documented to take a comma-separated list of statuses to filter by, but instead it used the parameter as a regexp. The @@ -1452,10 +1243,8 @@ command has been changed so that it now works as documented, and checks statuses not as a regexp, but instead an exact match from the comma-separated list. -+++ *** New command 'package-browse-url' and keystroke 'w'. -+++ *** New commands to filter the package list. The filter commands are bound to the following keys: @@ -1482,7 +1271,6 @@ run the native-compilation of the package files. (Be sure to leave Emacs running until these asynchronous subprocesses exit, or else the native-compilation will be aborted when you exit Emacs.) ---- *** Column widths in 'list-packages' display can now be customized. See the new user options 'package-name-column-width', 'package-version-column-width', 'package-status-column-width', and @@ -1490,7 +1278,6 @@ See the new user options 'package-name-column-width', ** Info ---- *** New user option 'Info-warn-on-index-alternatives-wrap'. This option affects what happens when using the ',' command after looking up an entry with 'i' in info buffers. If non-nil (the @@ -1500,7 +1287,6 @@ you to the first match. ** Abbrev mode -+++ *** Emacs can now suggest to use an abbrev based on text you type. A new user option, 'abbrev-suggest', enables the new abbrev suggestion feature. When enabled, if a user manually types a piece of text that @@ -1510,17 +1296,14 @@ used instead. ** Bookmarks ---- *** Bookmarks can now be targets for new tabs. When the bookmark.el library is loaded, a customize choice is added to 'tab-bar-new-tab-choice' for new tabs to show the bookmark list. ---- *** New user option 'bookmark-set-fringe-mark'. If non-nil, setting a bookmark will set a fringe mark on the current line, and jumping to a bookmark will also set this mark. ---- *** New user option 'bookmark-menu-confirm-deletion'. In Bookmark Menu mode, Emacs by default does not prompt for confirmation when you type 'x' to execute the deletion of bookmarks @@ -1528,7 +1311,6 @@ that have been marked for deletion. However, if this new option is non-nil then Emacs will require confirmation with 'yes-or-no-p' before deleting. ---- *** The 'list-bookmarks' menu is now based on 'tabulated-list-mode'. The interactive bookmark list will now benefit from features in 'tabulated-list-mode' like sorting columns or changing column width. @@ -1540,17 +1322,14 @@ The variables 'bookmark-bmenu-use-header-line' and ** Recentf ---- *** The recentf files are no longer backed up. ---- *** 'recentf-auto-cleanup' now repeats daily when set to a time string. When 'recentf-auto-cleanup' is set to a time string, it now repeats every day, rather than only running once after the mode is turned on. ** Calc ---- *** The behavior when doing forward-delete has been changed. Previously, using the 'C-d' command would delete the final number in the input field, no matter where point was. This has been changed to @@ -1558,42 +1337,35 @@ work more traditionally, with 'C-d' deleting the next character. Likewise, point isn't moved to the end of the string before inserting digits. -+++ *** Setting the word size to zero disables word clipping. The word size normally clips the results of certain bit-oriented operations such as shifts and bitwise XOR. A word size of zero, set by 'b w', makes the operation have effect on the whole argument values and the result is not truncated in any way. ---- *** The '/' operator now has higher precedence in (La)TeX input mode. It no longer has lower precedence than '+' and '-'. ---- *** New user option 'calc-make-windows-dedicated'. When this user option is non-nil, Calc will mark its windows as dedicated. ** Calendar -+++ *** New user option 'calendar-time-zone-style'. If 'numeric', calendar functions (eg 'calendar-sunrise-sunset') that display time zones will use a form like "+0100" instead of "CET". ** Imenu -+++ *** New user option 'imenu-max-index-time'. If creating the imenu index takes longer than specified by this option (default 5 seconds), imenu indexing is stopped. ** Ido ---- *** Switching on 'ido-mode' now also overrides 'ffap-file-finder'. ---- *** Killing virtual ido buffers interactively will make them go away. Previously, killing a virtual ido buffer with 'ido-kill-buffer' didn't do anything. This has now been changed, and killing virtual buffers @@ -1601,13 +1373,11 @@ with that command will remove the buffer from recentf. ** So Long ---- *** New 'so-long-predicate' function 'so-long-statistics-excessive-p'. It efficiently detects the presence of a long line anywhere in the buffer using 'buffer-line-statistics' (see above). This is now the default predicate (replacing 'so-long-detected-long-line-p'). ---- *** Default values 'so-long-threshold' and 'so-long-max-lines' increased. The values of these user options have been raised to 10000 bytes and 500 lines respectively, to reduce the likelihood of false-positives when @@ -1615,14 +1385,12 @@ lines respectively, to reduce the likelihood of false-positives when by the old predicate, as the new predicate knows the longest line in the entire buffer. ---- *** 'so-long-target-modes' now includes 'fundamental-mode' by default. This means that 'global-so-long-mode' will also process files which were not recognised. (This only has an effect if 'set-auto-mode' chooses 'fundamental-mode'; buffers which are simply in 'fundamental-mode' by default are unaffected.) ---- *** New user options to preserve modes and variables. The new options 'so-long-mode-preserved-minor-modes' and 'so-long-mode-preserved-variables' allow specified mode and variable @@ -1631,7 +1399,6 @@ mode. By default, these new options support 'view-mode'. ** Grep -+++ *** New user option 'grep-match-regexp' matches grep markers to highlight. Grep emits SGR ANSI escape sequences to color its output. The new user option 'grep-match-regexp' holds the regular expression to match @@ -1639,7 +1406,6 @@ the appropriate markers in order to provide highlighting in the source buffer. The user option can be customized to accommodate other grep-like tools. ---- *** The 'lgrep' command now ignores directories. On systems where the grep command supports it, directories will be skipped. @@ -1653,19 +1419,16 @@ any directory names on the 'find' command lines end in a slash. This change is for better compatibility with old versions of non-GNU 'find', such as the one used on macOS. ---- *** New utility function 'grep-file-at-point'. This returns the name of the file at point (if any) in 'grep-mode' buffers. ** Shell ---- *** 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). ---- *** New user option 'shell-has-auto-cd'. If non-nil, 'shell-mode' handles implicit "cd" commands, changing the directory if the command is a directory. Useful for shells like "zsh" @@ -1673,20 +1436,17 @@ that has this feature. ** Term mode ---- *** New user option 'term-scroll-snap-to-bottom'. By default, 'term' and 'ansi-term' will now recenter the buffer so 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'. 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 window after starting). This variable defaults to nil. ---- *** 'term-mode' now supports "bright" color codes. "Bright" ANSI color codes are now displayed using the color values defined in 'term-color-bright-*'. In addition, bold text with regular @@ -1695,15 +1455,12 @@ is non-nil. ** Eshell ---- *** 'eshell-hist-ignoredups' can now also be used to mimic "erasedups" in bash. ---- *** Environment variable 'INSIDE_EMACS' is now copied to subprocesses. Its value contains the result of evaluating '(format "%s,eshell" 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. Some modules have their own minor mode now to account for these @@ -1715,7 +1472,6 @@ will create a bookmark that opens the current directory in Eshell. ** Archive mode ---- *** Archive mode can now parse ".squashfs" files. *** Can now modify members of 'ar' archives. @@ -1727,7 +1483,6 @@ New user option 'archive-hidden-columns' and new command 'archive-hideshow-column' let you control which columns are displayed and which are kept hidden. ---- *** New command bound to 'C': 'archive-copy-file'. This command extracts the file at point and writes its data to a file. @@ -1756,15 +1511,12 @@ symbol property to the browsing commands. With a new command 'browse-url-with-browser-kind', an URL can explicitly be browsed with either an internal or external browser. ---- *** Support for browsing of remote files. If a remote file is specified, a local temporary copy of that file is passed to the browser. ---- *** Support for the conkeror browser is now obsolete. ---- *** Support for the Mosaic browser has been removed. This support has been obsolete since 25.1. @@ -1775,7 +1527,6 @@ New key bindings have been added to 'completion-list-mode': 'n' and 'p' now navigate completions, and 'M-g M-c' switches to the minibuffer and back to the completion list buffer. -+++ ** 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 @@ -1785,12 +1536,10 @@ layout back. ** Icomplete ---- *** New user option 'icomplete-matches-format'. This allows controlling the current/total number of matches for the prompt prefix. -+++ *** New minor modes 'icomplete-vertical-mode' and 'fido-vertical-mode'. These modes modify Icomplete ('icomplete-mode') and Fido ('fido-mode'), to display completion candidates vertically instead of @@ -1799,20 +1548,16 @@ kept at the top. In Fido, completions scroll like a typical dropdown widget. Both these new minor modes will turn on their non-vertical counterparts first, if they are not on already. ---- *** Default value of 'icomplete-compute-delay' has been changed to 0.15 s. ---- *** Default value of 'icomplete-max-delay-chars' has been changed to 2. ---- *** Reduced blinking while completing the next completions set. Icomplete doesn't hide the hint with the previously computed completions anymore when compute delay is in effect, or the previous computation has been aborted by input. Instead it shows the previous completions until the new ones are ready. ---- *** Change in meaning of 'icomplete-show-matches-on-no-input'. Previously, choosing a different completion with commands like 'C-.' and then hitting 'RET' would choose the default completion. Doing this @@ -1822,7 +1567,6 @@ with initial input as the default directory. ** Windmove -+++ *** New user options to customize windmove keybindings. These options include 'windmove-default-keybindings', 'windmove-display-default-keybindings', @@ -1832,25 +1576,20 @@ Also new mode 'windmove-mode' enables the customized keybindings. ** 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'. ---- *** New command 'recenter-current-error'. It is bound to 'l' in Occur or compilation buffers, and recenters the current displayed occurrence/error. ---- *** Matches in target buffers are now highlighted as in 'compilation-mode'. The method of highlighting is specified by the user options 'next-error-highlight' and 'next-error-highlight-no-select'. ---- *** A fringe arrow in the "*Occur*" buffer indicates the selected match. ---- *** Occur mode may use a different type for 'occur-target' property values. 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 @@ -1861,10 +1600,8 @@ work as before. ** Emacs Lisp mode ---- *** The mode-line now indicates whether we're using lexical or dynamic scoping. -+++ *** A space between an open paren and a symbol changes the indentation rule. 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 @@ -1876,37 +1613,31 @@ as a data list rather than as a piece of code. The mode provides refined highlighting of built-in functions, types, and variables. ---- *** Lisp mode now uses 'common-lisp-indent-function'. To revert to the previous behavior, '(setq lisp-indent-function 'lisp-indent-function)' from 'lisp-mode-hook'. ** Change Logs and VC -+++ *** 'vc-revert-show-diff' now has a third possible value: 'kill'. If this user option is 'kill', then the diff buffer will be killed after the 'vc-revert' action instead of buried. ---- *** More VC commands can be used from non-file buffers. The relevant commands are those that don't change the VC state. The non-file buffers which can use VC commands are those that have their 'default-directory' under VC. ---- *** New face 'log-view-commit-body'. This is used when expanding commit messages from 'vc-print-root-log' and similar commands. ---- *** New faces for 'vc-dir' buffers. Those are: 'vc-dir-header', 'vc-dir-header-value', 'vc-dir-directory', 'vc-dir-file', 'vc-dir-mark-indicator', 'vc-dir-status-warning', 'vc-dir-status-edited', 'vc-dir-status-up-to-date', 'vc-dir-status-ignored'. ---- *** The responsible VC backend is now the most specific one. 'vc-responsible-backend' loops over the backends in 'vc-handled-backends' to determine which backend is responsible for a @@ -1914,41 +1645,32 @@ specific (unregistered) file. Previously, the first matching backend was chosen, but now the one with the most specific path is chosen (in case there's a directory handled by one backend inside another). ---- *** New command 'vc-dir-root' uses the root directory without asking. ---- *** New commands 'vc-dir-mark-registered-files' (bound to '* r') and 'vc-dir-mark-unregistered-files'. ---- *** Support for bookmark.el. Bookmark locations can refer to VC directory buffers. ---- *** New user option 'vc-hg-create-bookmark'. It controls whether a bookmark or branch will be created when you invoke 'C-u C-x v s' ('vc-create-tag'). ---- *** 'vc-hg' now uses 'hg summary' to populate extra 'vc-dir' headers. ---- *** New user option 'vc-git-revision-complete-only-branches'. If non-nil, only branches and remotes are considered when doing completion over Git branch names. The default is nil, which causes tags to be considered as well. ---- *** New user option 'vc-git-log-switches'. String or list of strings specifying switches for Git log under VC. ---- *** Command 'vc-switch-backend' is now obsolete. If you are still using it with any regularity, please file a bug report with some details. ---- *** New variable 'vc-git-use-literal-pathspecs'. The Git backend's function now treat all file names "literally", where some of them previously could interpret file names (pathspecs) as @@ -1957,35 +1679,28 @@ the aforementioned variable to nil locally to avoid this. ** Gnus -+++ *** New user option 'gnus-topic-display-predicate'. This can be used to inhibit the display of some topics completely. -+++ *** nnimap now supports the oauth2.el library. -+++ *** New Summary buffer sort options for extra headers. The extra header sort option ('C-c C-s C-x') prompts for a header and fails if no sort function has been defined. Sorting by Newsgroups ('C-c C-s C-u') has been pre-defined. -+++ *** The '#' command in the Group and Summary buffer now toggles, instead of sets, the process mark. -+++ *** New user option 'gnus-process-mark-toggle'. If non-nil (the default), the '#' command in the Group and Summary buffers will toggle, instead of set, the process mark. -+++ *** New user option 'gnus-registry-register-all'. If non-nil (the default), create registry entries for all messages. If nil, don't automatically create entries, they must be created manually. -+++ *** New user options to customise the summary line specs "%[" and "%]". Four new options introduced in customisation group 'gnus-summary-format'. These are 'gnus-sum-opening-bracket', @@ -1998,29 +1713,24 @@ the value of 'gnus-sum-opening-bracket', but can also be normally display the value of 'gnus-sum-closing-bracket', but can also be 'gnus-sum-closing-bracket-adopted' for the adopted articles. -+++ *** New user option 'gnus-paging-select-next'. This controls what happens when using commands like 'SPC' and 'DEL' to page the current article. If non-nil (the default), go to the next/prev article, but if nil, do nothing at the end/start of the article. -+++ *** New gnus-search library. A new unified search syntax which can be used across multiple supported search engines. Set 'gnus-search-use-parsed-queries' to non-nil to enable. -+++ *** New value for user option 'smiley-style'. Smileys can now be rendered with emojis instead of small images when using the new 'emoji' value in 'smiley-style'. -+++ *** New user option 'gnus-agent-eagerly-store-articles'. If non-nil (which is the default), the Gnus Agent will store all read articles in the Agent cache. -+++ *** New user option 'gnus-global-groups'. Gnus handles private groups differently from public (i.e., NNTP-like) groups. Most importantly, Gnus doesn't download external images from @@ -2028,17 +1738,14 @@ mail-like groups. This can be overridden by putting group names in 'gnus-global-groups': Any group present in that list will be treated like a public group. -+++ *** New scoring types for the Date header. You can now score based on the relative age of an article with the new '<' and '>' date scoring types. -+++ *** User-defined scoring is now possible. The new type is 'score-fn'. More information in the Gnus manual node "(gnus) Score File Format". -+++ *** New backend 'nnselect'. The newly added 'nnselect' backend allows creating groups from an arbitrary list of articles that may come from multiple groups and @@ -2061,35 +1768,29 @@ has been removed; its functionality is now available directly in the 'gnus-refer-thread-use-nnir' has been renamed to 'gnus-refer-thread-use-search'. -+++ *** New user option 'gnus-dbus-close-on-sleep'. On systems with D-Bus support, it is now possible to register a signal to close all Gnus servers before the system sleeps. -+++ *** The key binding of 'gnus-summary-search-article-forward' has changed. This command was previously on 'M-s' and shadowed the global 'M-s' search prefix. The command has now been moved to 'M-s M-s'. (For consistency, the 'M-s M-r' key binding has been added for the 'gnus-summary-search-article-backward' command.) ---- *** The value for "all" in the 'large-newsgroup-initial' group parameter has changed. It was previously nil, which didn't work, because nil is indistinguishable from not being present. The new value for "all" is the symbol 'all'. -+++ *** The name of dependent Gnus sessions has changed from "slave" to "child". The names of the commands 'gnus-slave', 'gnus-slave-no-server' and 'gnus-slave-unplugged' have changed to 'gnus-child', 'gnus-child-no-server' and 'gnus-child-unplugged' respectively. -+++ *** The 'W Q' summary mode command now takes a numerical prefix to allow adjusting the fill width. -+++ *** New variable 'mm-inline-font-lock'. This variable is supposed to be bound by callers to determine whether inline MIME parts (that support it) are supposed to be font-locked or @@ -2097,23 +1798,19 @@ not. ** Message ---- *** Respect 'message-forward-ignored-headers' more. Previously, this user option would not be consulted if 'message-forward-show-mml' was nil and forwarding as MIME. -+++ *** New user option 'message-forward-included-mime-headers'. This is used when forwarding messages as MIME, but not using MML. -+++ *** Message now supports the OpenPGP header. To generate these headers, add the new function 'message-add-openpgp-header' to 'message-send-hook'. The header will be generated according to the new 'message-openpgp-header' user option. ---- *** A change to how "Mail-Copies-To: never" is handled. If a user has specified "Mail-Copies-To: never", and Message was asked to do a "wide reply", some other arbitrary recipient would end up in @@ -2123,7 +1820,6 @@ you're responding to a specific person in particular. This has been changed so that all the recipients are put in the "To" header in these instances. -+++ *** New command to start Emacs in Message mode to send an email. Emacs can be defined as a handler for the "x-scheme-handler/mailto" MIME type with the following command: "emacs -f message-mailto %u". @@ -2136,7 +1832,6 @@ Emacs with headers filled out according to the link, e.g. emacsclient, use "emacsclient -e '(message-mailto "%u")'" or "emacsclient-mail.desktop". ---- *** Change to default value of 'message-draft-headers' user option. The 'Date' symbol has been removed from the default value, meaning that draft or delayed messages will get a date reflecting when the message @@ -2144,7 +1839,6 @@ was sent. To restore the original behavior of dating a message from when it is first saved or delayed, add the symbol 'Date' back to this user option. -+++ *** New command to take screenshots. In Message mode buffers, the 'C-c C-p' ('message-insert-screenshot') command has been added. It depends on using an external program to @@ -2152,30 +1846,25 @@ take the actual screenshot, and defaults to "ImageMagick import". ** Smtpmail -+++ *** smtpmail now supports using the oauth2.el library. -+++ *** 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 command 'smtpmail-send-queued-mail'. -+++ *** Allow direct selection of smtp authentication mechanism. A server entry retrieved by auth-source can request a desired smtp authentication mechanism by setting a value for the key 'smtp-auth'. ** ElDoc -+++ *** New user option 'eldoc-echo-area-display-truncation-message'. If non-nil (the default), eldoc will display a message saying something like "(Documentation truncated. Use `M-x eldoc-doc-buffer' to see rest)" when a message has been truncated. If nil, truncated messages will be marked with just "..." at the end. -+++ *** New hook 'eldoc-documentation-functions'. This hook is intended to be used for registering doc string functions. These functions don't need to produce the doc string right away, they @@ -2190,7 +1879,6 @@ functions receive the doc string composed according to the user. Examples of such functions would use the echo area, a separate buffer, or a tooltip. -+++ *** New user option 'eldoc-documentation-strategy'. The built-in choices available for this user option let users compose the results of 'eldoc-documentation-functions' in various ways, even @@ -2206,33 +1894,27 @@ it when producing a doc string. ** Tramp -+++ *** New connection method "mtp". It allows accessing media devices like cell phones, tablets or cameras. -+++ *** New connection method "sshfs". It allows accessing remote files via a file system mounted with 'sshfs'. -+++ *** Tramp supports SSH authentication via a hardware security key now. This requires at least OpenSSH 8.2, and a FIDO U2F compatible security key, like yubikey, solokey, or nitrokey. -+++ *** Trashed remote files are moved to the local trash directory. All remote files that are trashed are moved to the local trash directory, except remote encrypted files, which are always deleted. -+++ *** New command 'tramp-crypt-add-directory'. This command marks a remote directory to contain only encrypted files. See the "(tramp) Keeping files encrypted" node of the Tramp manual for details. This feature is experimental. -+++ *** Support of direct asynchronous process invocation. When Tramp connection property "direct-async-process" is set to non-nil for a given connection, 'make-process' and 'start-file-process' @@ -2242,24 +1924,20 @@ performance of asynchronous remote processes" node of the Tramp manual for details, and also for a discussion or restrictions. This feature is experimental. -+++ *** New user option 'tramp-debug-to-file'. When non-nil, this user option instructs Tramp to mirror the debug buffer to a file under the "/tmp/" directory. This is useful, if (in rare cases) Tramp blocks Emacs, and we need further debug information. -+++ *** Tramp supports lock files now. In order to deactivate this, set user option 'remote-file-name-inhibit-locks' to t. -+++ *** Writing sensitive data locally requires confirmation. Writing auto-save, backup or lock files to the local temporary directory must be confirmed. In order to suppress this confirmation, set user option 'tramp-allow-unsafe-temporary-files' to t. -+++ *** 'make-directory' of a remote directory honors the default file modes. ** GDB/MI @@ -2268,7 +1946,6 @@ set user option 'tramp-allow-unsafe-temporary-files' to t. If non-nil, apply a register filter based on 'gdb-registers-filter-pattern-list'. -+++ *** gdb-mi can now save and restore window configurations. Use 'gdb-save-window-configuration' to save window configuration to a file and 'gdb-load-window-configuration' to load from a file. These @@ -2276,31 +1953,26 @@ commands can also be accessed through the menu bar under "Gud => GDB-Windows". 'gdb-default-window-configuration-file', when non-nil, is loaded when GDB starts up. -+++ *** gdb-mi can now restore window configuration after quitting. Set 'gdb-restore-window-configuration-after-quit' to non-nil and Emacs will remember the window configuration before GDB started and restore it after GDB quits. A toggle button is also provided under "Gud => GDB-Windows" menu item. -+++ *** gdb-mi now has a better logic for displaying source buffers. Now GDB only uses one source window to display source file by default. Customize 'gdb-max-source-window-count' to use more than one window. Control source file display by 'gdb-display-source-buffer-action'. -+++ *** The default value of 'gdb-mi-decode-strings' is now t. This means that the default coding-system is now used to decode strings and source file names from GDB. ** Compilation mode ---- *** New function 'ansi-color-compilation-filter'. This function is meant to be used in 'compilation-filter-hook'. ---- *** New user option 'ansi-color-for-compilation-mode'. This controls what 'ansi-color-compilation-filter' does. @@ -2310,7 +1982,6 @@ case-insensitive matching of messages when the old behavior is required, but the recommended solution is to use a correctly matching regexp instead. ---- *** New user option 'compilation-search-all-directories'. When doing parallel builds, directories and compilation errors may arrive in the "*compilation*" buffer out-of-order. If this option is @@ -2318,45 +1989,37 @@ non-nil (the default), Emacs will now search backwards in the buffer for any directory the file with errors may be in. If nil, this won't be done (and this restores how this previously worked). ---- *** Messages from ShellCheck are now recognized. ---- *** Messages from Visual Studio that mention column numbers are now recognized. ** Hi Lock mode ---- *** Matching in 'hi-lock-mode' can be case-sensitive. The matching is case-sensitive when a regexp contains upper case characters and 'search-upper-case' is non-nil. 'highlight-phrase' also uses 'search-whitespace-regexp' to substitute spaces in regexp search. ---- *** The default value of 'hi-lock-highlight-range' was enlarged. The new default value is 2000000 (2 megabytes). ** Whitespace mode -+++ *** New style 'missing-newline-at-eof'. If present in 'whitespace-style' (as it is by default), the final character in the buffer will be highlighted if the buffer doesn't end with a newline. ---- *** The default 'whitespace-enable-predicate' predicate has changed. It used to check elements in the list version of 'whitespace-global-modes' with 'eq', but now uses 'derived-mode-p'. ** Texinfo ---- *** New user option 'texinfo-texi2dvi-options'. This is used when invoking 'texi2dvi' from 'texinfo-tex-buffer'. ---- *** New commands for moving in and between environments. An "environment" is something that ends with '@end'. The commands are 'C-c C-c C-f' (next end), 'C-c C-c C-b' (previous end), @@ -2366,19 +2029,16 @@ current environment. ** Rmail ---- *** New user option 'rmail-re-abbrevs'. Its default value matches localized abbreviations of the "reply" prefix on the Subject line in various languages. ---- *** New user option 'rmail-show-message-set-modified'. 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 -+++ *** Added support for Doxygen documentation style. 'doxygen' is now a valid 'c-doc-comment-style' which recognises all comment styles supported by Doxygen (namely '///', '//!', '/** … */' @@ -2393,7 +2053,6 @@ use 'doxygen' by default one might evaluate: or use it in a custom 'c-style'. -+++ *** Added support to line up '?' and ':' of a ternary operator. The new 'c-lineup-ternary-bodies' function can be used as a lineup function to align question mark and colon which are part of a ternary @@ -2413,30 +2072,25 @@ To enable, add it to appropriate entries in 'c-offsets-alist', e.g.: ** Images ---- *** You can explicitly specify base_uri for svg images. ':base-uri' image property can be used to explicitly specify base_uri for embedded images into svg. ':base-uri' is supported for both file and data svg images. -+++ *** 'svg-embed-base-uri-image' added to embed images. 'svg-embed-base-uri-image' can be used to embed images located relatively to 'file-name-directory' of the ':base-uri' svg image property. This works much faster than 'svg-embed'. -+++ *** New function 'image-cache-size'. This function returns the size of the current image cache, in bytes. ---- *** Animated images stop automatically under high CPU pressure sooner. Previously, an animated image would stop animating if any single image took more than two seconds to display. The new algorithm maintains a decaying average of delays, and if this number gets too high, the animation is stopped. -+++ *** The 'n' and 'p' commands (next/previous image) now respect Dired order. These commands would previously display the next/previous image in lexicographic order, but will now find the "parent" Dired buffer and @@ -2445,7 +2099,6 @@ sorted there. The commands have also been extended to work when the "parent" buffer is an archive mode (i.e., zip file or the like) or tar mode buffer. ---- *** 'image-converter' is now restricted to formats in 'auto-mode-alist'. When using external image converters, the external program is queried for what formats it supports. This list may contain formats that are @@ -2453,7 +2106,6 @@ problematic in some contexts (like PDFs), so this list is now filtered based on 'auto-mode-alist'. Only file names that map to 'image-mode' are now supported. ---- *** The background and foreground of images now default to face colors. When an image doesn't specify a foreground or background color, Emacs now uses colors from the face used to draw the surrounding text @@ -2469,7 +2121,6 @@ To load images with the default frame colors use the ':foreground' and This change only affects image types that support foreground and background colors or transparency, such as xbm, pbm, svg, png and gif. -+++ *** Image smoothing can now be explicitly enabled or disabled. Smoothing applies a bilinear filter while scaling or rotating an image to prevent aliasing and other unwanted effects. The new image @@ -2479,13 +2130,11 @@ and nil to disable smoothing. The default behavior of smoothing on down-scaling and not smoothing on up-scaling remains unchanged. -+++ *** New user option 'image-transform-smoothing'. This controls whether to use smoothing or not for an image. Values include nil (no smoothing), t (do smoothing) or a predicate function that's called with the image object and should return nil/t. -+++ *** SVG images now support user stylesheets. The ':css' image attribute can be used to override the default CSS stylesheet for an image. The default sets 'font-family' and @@ -2494,7 +2143,6 @@ will match the font size in use where it is embedded. This feature relies on librsvg 2.48 or above being available. -+++ *** Image properties support 'em' sizes. Size image properties, for example ':height', ':max-height', etc., can be given a cons of the form '(SIZE . em)', where SIZE is an integer or @@ -2503,42 +2151,35 @@ size, and 'em' is a symbol. ** EWW -+++ *** New user option 'eww-use-browse-url'. This is a regexp that can be set to alter how links are followed in eww. -+++ *** New user option 'eww-retrieve-command'. This can be used to download data via an external command. If nil (the default), then 'url-retrieve' is used. When 'sync', then 'url-retrieve-synchronously' is used. A list of strings specifies an external program with parameters. -+++ *** New Emacs command line convenience command. The 'eww-browse' command has been added, which allows you to register Emacs as a MIME handler for "text/x-uri", and will call 'eww' on the supplied URL. Usage example: "emacs -f eww-browse https://gnu.org". -+++ *** 'eww-download-directory' will now use the XDG location, if defined. However, if "~/Downloads/" already exists, that will continue to be used. ---- *** 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. ---- *** Support for bookmark.el. The command 'bookmark-set' (bound to 'C-x r m') is now supported, and will create a bookmark that opens the current URL in EWW. ** SHR ---- *** 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-mail'. @@ -2546,7 +2187,6 @@ 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. ---- *** New user option 'shr-offer-extend-specpdl'. If this is nil, rendering of HTML that requires enlarging 'max-specpdl-size', the number of Lisp variable bindings, will be @@ -2554,7 +2194,6 @@ aborted, and Emacs will not ask you whether to enlarge 'max-specpdl-size' to complete the rendering. The default is t, which preserves the original behavior. -+++ *** New user option 'shr-max-width'. If this user option is non-nil, and 'shr-width' is nil, then SHR will use the value of 'shr-max-width' to limit the width of the rendered @@ -2564,80 +2203,64 @@ to a more readable text. Customize it to nil to get the previous behavior of rendering as wide as the 'window-width' allows. If 'shr-width' is non-nil, it overrides this option. ---- *** New faces for heading elements. Those are 'shr-h1', 'shr-h2', 'shr-h3', 'shr-h4', 'shr-h5', 'shr-h6'. ** Project ---- *** New user option 'project-vc-merge-submodules'. ---- *** Project commands now have their own history. Previously used project directories are now suggested by all commands that prompt for a project directory. -+++ *** New prefix keymap 'project-prefix-map'. Key sequences that invoke project-related commands start with the prefix 'C-x p'. Type 'C-x p C-h' to show the full list. -+++ *** New commands 'project-dired', 'project-vc-dir', 'project-shell', 'project-eshell'. These commands run Dired/VC-Dir and Shell/Eshell in a project's root directory, respectively. -+++ *** New command 'project-compile'. This command runs compilation in the current project's root directory. -+++ *** New command 'project-switch-project'. This command lets you "switch" to another project and run a project command chosen from a dispatch menu. -+++ *** New commands 'project-shell-command' and 'project-async-shell-command'. These commands run 'shell-command' and 'async-shell-command' in a project's root directory, respectively. -+++ *** New user option 'project-list-file'. This specifies the file in which to save the list of known projects. -+++ *** New command 'project-remember-projects-under'. This command can automatically locate and index projects in a directory and optionally also its subdirectories, storing them in 'project-list-file'. -+++ *** New commands 'project-forget-project' and 'project-forget-projects-under'. These commands let you interactively remove entries from the list of projects in 'project-list-file'. -+++ *** New command 'project-forget-zombie-projects'. This command detects indexed projects that have since been deleted, and removes them from the list of known projects in 'project-list-file'. ---- *** 'project-find-file' now accepts non-existent file names. This is to allow easy creation of files inside some nested sub-directory. -+++ *** 'project-find-file' doesn't use the string at point as default input. Now it's only suggested as part of the "future history", accessible via 'M-n'. -+++ *** New command 'project-find-dir' runs Dired in a directory inside project. ** Xref -+++ *** New user options to automatically show the first Xref match. The new user option 'xref-auto-jump-to-first-definition' controls the behavior of 'xref-find-definitions' and its variants, like @@ -2653,57 +2276,47 @@ visit. 'xref-auto-jump-to-first-xref' changes their behavior much in the same way as 'xref-auto-jump-to-first-definition' affects the 'xref-find-definitions*' commands. ---- *** New user options 'xref-search-program' and 'xref-search-program-alist'. So far 'grep' and 'ripgrep' are supported. 'ripgrep' seems to offer better performance in certain cases, in particular for case-insensitive searches. -+++ *** New commands 'xref-prev-group' and 'xref-next-group'. These commands are bound respectively to 'P' and 'N', and navigate to the first item of the previous or next group in the "*xref*" buffer. ---- *** New alternative value for 'xref-show-definitions-function': 'xref-show-definitions-completing-read'. ---- *** The two existing alternatives for 'xref-show-definitions-function' have been renamed to have "proper" public names and documented ('xref-show-definitions-buffer' and 'xref-show-definitions-buffer-at-bottom'). -+++ *** New command 'xref-quit-and-pop-marker-stack'. This command is bound to 'M-,' in "*xref*" buffers. This combination is easy to press semi-accidentally if the user wants to go back in the middle of choosing the exact definition to go to, and this should do TRT. ---- *** New value 'project-relative' for 'xref-file-name-display'. If chosen, file names in "*xref*" buffers will be displayed relative to the 'project-root' of the current project, when available. ---- *** Prefix arg of 'xref-goto-xref' quits the "*xref*" buffer. So typing 'C-u RET' in the "*xref*" buffer quits its window before navigating to the selected location. -+++ *** The 'TAB' key binding in "*xref*" buffers is obsolete. Use 'C-u RET' instead. The 'TAB' binding in "*xref*" buffers is still supported, but we plan on removing it in a future version; at that time, the command 'xref-quit-and-goto-xref' will no longer have a key binding in 'xref--xref-buffer-mode-map'. ---- *** New user option 'etags-xref-prefer-current-file'. When non-nil, matches for identifiers in the file visited by the current buffer will be shown first in the "*xref*" buffer. -+++ *** The etags Xref backend now honors 'tags-apropos-additional-actions'. You can customize it to augment the output of 'xref-find-apropos', like it affected the output of 'tags-apropos', which is obsolete since @@ -2711,7 +2324,6 @@ Emacs 25.1. ** Battery ---- *** UPower is now the default battery status backend when available. UPower support via the function 'battery-upower' was added in Emacs 26.1, but was disabled by default. It is now the default value of @@ -2721,7 +2333,6 @@ service. The user options 'battery-upower-device' and whether to respond to status change notifications in addition to polling, respectively. ---- *** A richer syntax can be used to format battery status information. The user options 'battery-mode-line-format' and 'battery-echo-area-format' now support the full formatting syntax of @@ -2731,7 +2342,6 @@ truncation, amongst other things. ** Bug Reference ---- *** Bug reference mode uses auto-setup. If 'bug-reference-mode' or 'bug-reference-prog-mode' have been activated, their respective hook has been run, and both @@ -2748,17 +2358,14 @@ variables 'bug-reference-setup-from-vc-alist', ** HTML mode ---- *** A new skeleton for adding relative URLs has been added. It's bound to the 'C-c C-c f' keystroke, and prompts for a local file name. ** Widget -+++ *** 'widget-choose' now supports menus in extended format. ---- *** The 'editable-list' widget now supports moving items up and down. You can now move items up and down by deleting and then reinserting them, using the 'DEL' and 'INS' buttons respectively. This is useful @@ -2767,62 +2374,50 @@ a list. ** Diff ---- *** New face 'diff-changed-unspecified'. This is used to highlight "changed" lines (those marked with '!') in context diffs, when 'diff-use-changed-face' is non-nil. ---- *** New 'diff-mode' font locking face 'diff-error'. 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 -+++ *** New 'thing-at-point' target: 'existing-filename'. This is like 'filename', but is a full path, and is nil if the file doesn't exist. -+++ *** New 'thing-at-point' target: 'string'. If point is inside a string, it returns that string. -+++ *** New variable 'thing-at-point-provider-alist'. This allows mode-specific alterations to how 'thing-at-point' works. ---- *** '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. ---- *** New function 'thing-at-mouse'. This is like 'thing-at-point', but uses the mouse event position instead. ** Image Dired -+++ *** New user option 'image-dired-thumb-visible-marks'. If non-nil (the default), use the new face 'image-dired-thumb-mark' for marked images. ---- *** New command 'image-dired-delete-marked'. ---- *** 'image-dired-mouse-toggle-mark' is now sensitive to the active region. If the region is active, this command now toggles Dired marks of all the thumbnails in the region. ** Flymake mode -+++ *** New command 'flymake-show-project-diagnostics'. This lists all diagnostics for buffers in the currently active project. The listing is similar to the one obtained by @@ -2831,7 +2426,6 @@ project-relative file name. For backends which support it, 'flymake-show-project-diagnostics' also lists diagnostics for files that have not yet been visited. -+++ *** New user options to customize Flymake's mode-line. The new user option 'flymake-mode-line-format' is a mix of strings and symbols like 'flymake-mode-line-title', 'flymake-mode-line-exception' @@ -2842,7 +2436,6 @@ like 'flymake-mode-line-error-counter', ** Time ---- *** 'display-time-world' has been renamed to 'world-clock'. 'world-clock' creates a buffer with an updating time display using several time zones. It is hoped that the new names are more @@ -2865,21 +2458,17 @@ The following user options have been renamed: The old names are now obsolete. ---- *** 'world-clock-mode' can no longer be turned on interactively. Use 'world-clock' to turn on that mode. ** Python mode ---- *** New user option 'python-forward-sexp-function'. This allows the user easier customization of whether to use block-based navigation or not. ---- *** 'python-shell-interpreter' now defaults to python3 on systems with python3. ---- *** 'C-c C-r' can now be used on arbitrary regions. The command previously extended the start of the region to the start of the line, but will now actually send the marked region, as @@ -2887,12 +2476,10 @@ documented. ** Ruby mode ---- *** 'ruby-use-smie' is declared obsolete. SMIE is now always enabled and 'ruby-use-smie' only controls whether indentation is done using SMIE or with the old ad-hoc code. ---- *** Indentation has changed when 'ruby-align-chained-calls' is non-nil. This previously used to align subsequent lines with the last sibling, but it now aligns with the first sibling (which is the preferred style @@ -2900,10 +2487,8 @@ in Ruby). ** CPerl mode ---- *** New face 'perl-heredoc', used for heredoc elements. ---- *** The command 'cperl-set-style' offers the new value "PBP". This value customizes Emacs to use the style recommended in Damian Conway's book "Perl Best Practices" for indentation and formatting @@ -2911,20 +2496,17 @@ of conditionals. ** Perl mode ---- *** New face 'perl-non-scalar-variable'. This is used to fontify non-scalar variables. ** Octave mode -+++ *** Line continuations in double-quoted strings now use a backslash. Typing 'C-M-j' (bound to 'octave-indent-new-comment-line') now follows the behavior introduced in Octave 3.8 of using a backslash as a line continuation marker within double-quoted strings, and an ellipsis everywhere else. -+++ ** EasyPG GPG key servers can now be queried for keys with the 'epa-search-keys' command. Keys can then be added to your @@ -2932,11 +2514,9 @@ personal key ring. ** Etags -+++ *** Etags now supports the Mercury programming language. See https://mercurylang.org. -+++ *** Etags command line option '--declarations' now has Mercury-specific behavior. All Mercury declarations are tagged by default. However, for compatibility with 'etags' support for Prolog, predicates and @@ -2945,7 +2525,6 @@ invoked with the '--declarations' command-line option. ** Comint -+++ *** Support for OSC escape sequences. Adding the new function 'comint-osc-process-output' to 'comint-output-filter-functions' enables the interpretation of OSC @@ -2955,18 +2534,15 @@ tracking, are acted upon. Adding more entries to 'comint-osc-handlers' allows a customized treatment of further escape 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 ---- *** Colors are now defined by faces. ANSI SGR codes now have corresponding faces to describe their appearance, e.g. 'ansi-color-bold'. ---- *** Support for "bright" color codes. "Bright" ANSI color codes are now displayed when applying ANSI color filters using the color values defined by the faces @@ -2981,45 +2557,37 @@ user-visible changes in ERC. ** Xwidget Webkit mode ---- *** New xwidget commands. 'xwidget-webkit-uri' (return the current URL), 'xwidget-webkit-title' (return the current title), and 'xwidget-webkit-goto-history' (goto a point in history). ---- *** Downloading files from xwidget-webkit is now supported. The new user option 'xwidget-webkit-download-dir' says where to download to. ---- *** New command 'xwidget-webkit-clone-and-split-below'. Open a new window below displaying the current URL. ---- *** New command 'xwidget-webkit-clone-and-split-right'. Open a new window to the right displaying the current URL. ---- *** Pixel-based scrolling. The 'xwidget-webkit-scroll-up', 'xwidget-webkit-scroll-down' commands now supports scrolling arbitrary pixel values. It now treats the optional 2nd argument as the pixel values to scroll. ---- *** New commands for scrolling. The new commands 'xwidget-webkit-scroll-up-line', 'xwidget-webkit-scroll-down-line', 'xwidget-webkit-scroll-forward', 'xwidget-webkit-scroll-backward' can be used to scroll webkit by the height of lines or width of chars. ---- *** New user option 'xwidget-webkit-bookmark-jump-new-session'. When non-nil, use a new xwidget webkit session after bookmark jump. Otherwise, it will use 'xwidget-webkit-last-session'. ** Checkdoc ---- *** No longer warns about command substitutions by default. Checkdoc used to warn about "too many command substitutions" (as in "\\[foo-command]"), even if you only used ten of them in a docstring. @@ -3028,19 +2596,16 @@ substitutions before it becomes a performance issue, so this warning is now disabled by default. To re-enable this warning, customize the user option 'checkdoc-max-keyref-before-warn'. ---- *** New user option 'checkdoc-column-zero-backslash-before-paren'. Checkdoc warns if there is a left parenthesis in column zero of a documentation string. That warning can now be disabled by customizing this new user option to nil. This is useful if you don't expect your code to be edited with an Emacs older than version 27.1. ---- *** Now checks the prompt format for 'yes-or-no-p'. In addition to verifying the format of the prompt for 'y-or-n-p', checkdoc will now check the format of 'yes-or-no-p'. ---- *** New command 'checkdoc-dired'. This can be used to run checkdoc on files from a Dired buffer. @@ -3052,14 +2617,12 @@ this warning therefore mostly led to false positives. ** Enriched mode ---- *** 'C-a' is by default no longer bound to 'beginning-of-line-text'. This is so 'C-a' works as in other modes, and in particular holding Shift while typing 'C-a', i.e. 'C-S-a', will now highlight the text. ** Gravatar ---- *** New user option 'gravatar-service' for host to query for gravatars. Defaults to 'gravatar', with 'unicornify' and 'libravatar' as options. @@ -3068,89 +2631,69 @@ Defaults to 'gravatar', with 'unicornify' and 'libravatar' as options. Functions and variables related to handling junk mail have been renamed to not associate color with sender quality. -+++ *** New names for mh-junk interactive functions. Function 'mh-junk-whitelist' is renamed 'mh-junk-allowlist'. Function 'mh-junk-blacklist' is renamed 'mh-junk-blocklist'. -+++ *** New binding for 'mh-junk-allowlist'. The key binding for 'mh-junk-allowlist' is changed from 'J w' to 'J a'. The old binding is supported but warns that it is obsolete. -+++ *** New names for some hooks. 'mh-whitelist-msg-hook' is renamed 'mh-allowlist-msg-hook'. 'mh-blacklist-msg-hook' is renamed 'mh-blocklist-msg-hook'. -+++ *** New names for some user options. User option 'mh-whitelist-preserves-sequences-flag' is renamed 'mh-allowlist-preserves-sequences-flag'. -+++ *** New names for some faces. Face 'mh-folder-blacklisted' is renamed 'mh-folder-blocklisted'. Face 'mh-folder-whitelisted' is renamed 'mh-folder-allowlisted'. ** Rcirc -+++ *** rcirc now supports SASL authentication. ---- *** #emacs on Libera.chat has been added to 'rcirc-server-alist'. ---- *** rcirc connects asynchronously. ---- *** Integrate formatting into 'rcirc-send-string'. The function now accepts a variable number of arguments. -+++ *** Deprecate 'rcirc-command' in favor of 'rcirc-define-command'. The new macro handles multiple and optional arguments. ---- *** Add basic IRCv3 support. This includes support for the capabilities: 'server-time', 'batch', 'message-ids', 'invite-notify', 'multi-prefix' and 'standard-replies'. ---- *** Add mouse property support to 'rcirc-track-minor-mode'. ---- *** Improve support for IRC markup codes. ---- *** Check 'auth-sources' for server passwords. -+++ *** Implement repeated reconnection strategy. See 'rcirc-reconnect-attempts'. ** MPC ---- *** New command 'mpc-goto-playing-song'. This command, bound to 'o' in any 'mpc-mode' buffer, moves point to the currently playing song in the "*MPC-Songs*" buffer. ---- *** New user option 'mpc-cover-image-re'. If non-nil, it is a regexp that should match a valid cover image. ** Miscellaneous ---- *** 'shell-script-mode' now supports 'outline-minor-mode'. The outline headings have lines that start with "###". ---- *** fileloop will now skip missing files instead of signalling an error. ---- *** 'tabulated-list-mode' can now restore original display order. Many commands (like 'C-x C-b') are derived from 'tabulated-list-mode', and that mode allows the user to sort on any column. There was @@ -3158,73 +2701,58 @@ previously no easy way to get back to the original displayed order after sorting, but giving a -1 numerical prefix to the sorting command will now restore the original order. ---- *** 'M-left' and 'M-right' now move between columns in 'tabulated-list-mode'. ---- *** New variable 'hl-line-overlay-priority'. This can be used to change the priority of the hl-line overlays. -+++ *** New command 'mailcap-view-file'. This command will open a viewer based on the file type, as determined by "~/.mailcap" and related files and variables. ---- *** New user option 'remember-diary-regexp'. ---- *** New user option 'remember-text-format-function'. ---- *** New user option 'authinfo-hide-elements'. This can be set to nil to inhibit hiding passwords in ".authinfo" files. ---- *** 'hexl-mode' scrolling commands now heed 'next-screen-context-lines'. Previously, 'hexl-scroll-down' and 'hexl-scroll-up' would scroll up/down an entire window, but they now work more like the standard scrolling commands. ---- *** New user option 'bibtex-unify-case-function'. This new option allows the user to customize how case is converted when unifying entries. ---- *** The user option 'bibtex-maintain-sorted-entries' now permits 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 the command 'reveal-hide-revealed' can be used to hide all the revealed text. ---- *** New user option 'ffap-file-name-with-spaces'. If non-nil, 'find-file-at-point' and friends will try to guess more expansively to identify a file name with spaces. Default value is nil. ---- *** Two new commands for centering in 'doc-view-mode'. The new commands 'doc-view-center-page-horizontally' (bound to 'c h') and 'doc-view-center-page-vertically' (bound to 'c v') center the page horizontally and vertically, respectively. ---- *** 'tempo-define-template' can now re-assign templates to tags. Previously, assigning a new template to an already defined tag had no effect. ---- *** The width of the buffer-name column in 'list-buffers' is now dynamic. The width now depends on the width of the window, but will never be wider than the length of the longest buffer name, except that it will never be narrower than 19 characters. -+++ *** New diary sexp 'diary-offset'. It offsets another diary sexp by a number of days. This is useful when for example your organization has a committee meeting two days @@ -3232,13 +2760,10 @@ after every monthly meeting which takes place on the third Thursday, or if you would like to attend a virtual meeting scheduled in a different timezone causing a difference in the date. ---- *** The old non-SMIE indentation of 'sh-mode' has been removed. ---- *** 'mspools-show' is now autoloaded. ---- *** Loading dunnet.el in batch mode doesn't start the game any more. Instead you need to do "emacs --batch -f dunnet" to start the game in batch mode. @@ -3246,7 +2771,6 @@ batch mode. * New Modes and Packages in Emacs 28.1 -+++ ** New mode 'repeat-mode' to allow shorter key sequences. Type 'M-x repeat-mode' to enable this mode. You can then type 'C-x u u' instead of 'C-x u C-x u' to undo many changes, 'C-x o o' @@ -3272,7 +2796,6 @@ columns. Command 'describe-repeat-maps' will display a buffer showing which commands are repeatable in 'repeat-mode'. ---- ** New themes 'modus-vivendi' and 'modus-operandi'. These themes are designed to conform with the highest standard for color-contrast accessibility (WCAG AAA). You can load either of them @@ -3288,14 +2811,12 @@ This is a mode for searching a RFC 2229 dictionary server. the mouse in 'dictionary-tooltip-dictionary' (which must be customized first). ---- ** Lisp Data mode The new command 'lisp-data-mode' enables a major mode for buffers composed of Lisp symbolic expressions that do not form a computer program. The ".dir-locals.el" file is automatically set to use this mode, as are other data files produced by Emacs. -+++ ** New global mode 'global-goto-address-mode'. This will enable 'goto-address-mode' in all buffers. @@ -3309,7 +2830,6 @@ similar to prefix arguments, but are more flexible and discoverable. This library can create, query, navigate and display hierarchical structures. ---- ** New major mode for displaying the "etc/AUTHORS" file. This new 'etc-authors-mode' provides font-locking for displaying the "etc/AUTHORS" file from the Emacs distribution, and not much else. @@ -3317,13 +2837,11 @@ This new 'etc-authors-mode' provides font-locking for displaying the * Incompatible Lisp Changes in Emacs 28.1 -+++ ** Emacs now prints a backtrace when signaling an error in batch mode. This makes debugging Emacs Lisp scripts run in batch mode easier. To get back the old behavior, set the new variable 'backtrace-on-error-noninteractive' to a nil value. ---- ** Some floating-point numbers are now handled differently by the Lisp reader. In previous versions of Emacs, numbers with a trailing dot and an exponent were read as integers and the exponent ignored: 2.e6 was interpreted as the @@ -3331,28 +2849,24 @@ integer 2. Such numerals are now read as floats with the exponent included: 2.e6 is now read as the floating-point value 2000000.0. That is, '(read-from-string "1.e3")' => '(1000.0 . 4)' now. ---- ** 'equal' no longer examines some contents of window configurations. Instead, it considers window configurations to be equal only if they are 'eq'. To compare contents, use 'compare-window-configurations' instead. This change helps fix a bug in 'sxhash-equal', which returned incorrect hashes for window configurations and some other objects. -+++ ** The 'lexical-binding' local variable is always enabled. Previously, if 'enable-local-variables' was nil, a 'lexical-binding' local variable would not be heeded. This has now changed, and a file with a 'lexical-binding' cookie is always heeded. To revert to the old behavior, set 'permanently-enabled-local-variables' to nil. -+++ ** '&rest' in argument lists must always be followed by a variable name. Omitting the variable name after '&rest' was previously tolerated in some cases but not consistently so; it could lead to crashes or outright wrong results. Since the utility was marginal at best, it is now an error to omit the variable. ---- ** 'kill-all-local-variables' has changed how it handles non-symbol hooks. The function is documented to eliminate all buffer-local bindings except variables with a 'permanent-local' property, or hooks that @@ -3360,14 +2874,12 @@ have elements with a 'permanent-local-hook' property. In addition, it would also keep lambda expressions in hooks sometimes. The latter has now been changed: The function will now also remove these. -+++ ** Temporary buffers no longer run certain buffer hooks. The macros 'with-temp-buffer' and 'with-temp-file' no longer run the hooks 'kill-buffer-hook', 'kill-buffer-query-functions', and 'buffer-list-update-hook' for the temporary buffers they create. This avoids slowing them down when a lot of these hooks are defined. -+++ ** New face 'child-frame-border' and frame parameter 'child-frame-border-width'. The face and width of child frames borders can now be determined separately from those of normal frames. To minimize backward @@ -3376,7 +2888,6 @@ parameter will fall back to using 'internal-border-width'. However, the new 'child-frame-border' face does constitute a breaking change since child frames' borders no longer use the 'internal-border' face. ---- ** 'run-at-time' now tries harder to implement the t TIME parameter. If TIME is t, the timer runs at an integral multiple of REPEAT. (I.e., if given a REPEAT of 60, it'll run at 08:11:00, 08:12:00, @@ -3387,18 +2898,15 @@ has now changed, and the timer code now recomputes the integral multiple every time it runs, which means that if the laptop wakes at 08:16:43, it'll fire at that time, but then at 08:17:00, 08:18:00... ---- ** 'parse-partial-sexp' now signals an error if TO is smaller than FROM. Previously, this would lead to the function interpreting FROM as TO and vice versa, which would be confusing when passing in OLDSTATE, which refers to the old state at FROM. -+++ ** 'global-mode-string' constructs should end with a space. This was previously not formalized, which led to combinations of modes displaying data "smushed together" on the mode line. -+++ ** 'overlays-in' now handles zero-length overlays slightly differently. Previously, zero-length overlays at the end of the buffer were included in the result (if the region queried for stopped at that position). @@ -3406,7 +2914,6 @@ The same was not the case if the buffer had been narrowed to exclude the real end of the buffer. This has now been changed, and zero-length overlays at 'point-max' are always included in the results. ---- ** 'replace-match' now runs modification hooks slightly later. The function is documented to leave point after the replacement text, but this was not always the case if a modification hook inserted text @@ -3415,28 +2922,23 @@ point where the end of the inserted text would have been before the hook ran. 'replace-match' now always leaves point after the replacement text. -+++ ** 'completing-read-default' sets completion variables buffer-locally. 'minibuffer-completion-table' and related variables are now set buffer-locally in the minibuffer instead of being set via a global let-binding. ---- ** XML serialization functions now reject invalid characters. Previously, 'xml-print' would produce invalid XML when given a string with characters that are not valid in XML (see https://www.w3.org/TR/xml/#charsets). Now it rejects such strings. ---- ** JSON ---- *** JSON number parsing is now stricter. Numbers with a leading plus sign, leading zeros, or a missing integer component are now rejected by 'json-read' and friends. This makes them more compliant with the JSON specification and consistent with the native JSON parsing functions. ---- *** JSON functions support the semantics of RFC 8259. The JSON functions 'json-serialize', 'json-insert', 'json-parse-string', and 'json-parse-buffer' now implement some of the @@ -3444,7 +2946,6 @@ semantics of RFC 8259 instead of the earlier RFC 4627. In particular, these functions now accept top-level JSON values that are neither arrays nor objects. ---- *** Some JSON encoding functions are now obsolete. The functions 'json-encode-number', 'json-encode-hash-table', 'json-encode-key', and 'json-encode-list' are now obsolete. @@ -3454,7 +2955,6 @@ used instead. Uses of 'json-encode-list' should be changed to call one of 'json-encode', 'json-encode-alist', 'json-encode-plist', or 'json-encode-array' instead. -+++ *** Native JSON functions now signal an error if libjansson is unavailable. This affects 'json-serialize', 'json-insert', 'json-parse-string', and 'json-parse-buffer'. This can happen if Emacs was compiled with @@ -3462,148 +2962,117 @@ libjansson, but the DLL cannot be found and/or loaded by Emacs at run time. Previously, Emacs would display a message and return nil in these cases. -+++ ** The use of positional arguments in 'define-minor-mode' is obsolete. These were actually rendered obsolete in Emacs 21 but were never marked as such. ---- ** 'pcomplete-ignore-case' is now an obsolete alias of 'completion-ignore-case'. -+++ ** 'completions-annotations' face is not used when the caller puts own face. This affects the suffix specified by completion 'annotation-function'. -+++ ** An active minibuffer now has major mode 'minibuffer-mode'. This is instead of the erroneous 'minibuffer-inactive-mode' it formerly had. ---- ** 'make-text-button' no longer modifies text properties of its first argument. When its first argument is a string, 'make-text-button' no longer modifies the string's text properties; instead, it uses and returns a copy of the string. This helps avoid trouble when strings are shared or constants. -+++ ** Some properties from completion tables are now preserved. If 'minibuffer-allow-text-properties' is non-nil, doing completion over a table of strings with properties will no longer remove all the properties before returning. This affects things like 'completing-read'. ---- ** 'dns-query' now consistently uses Lisp integers to represent integers. Formerly it made an exception for integer components of SOA records, because SOA serial numbers can exceed fixnum ranges on 32-bit platforms. Emacs now supports bignums so this old glitch is no longer needed. -+++ ** The '&define' keyword in an Edebug specification now disables backtracking. The implementation was buggy, and multiple '&define' forms in an '&or' form should be exceedingly rare. See the Info node "(elisp) Backtracking" in the Emacs Lisp reference manual for background. -+++ ** The error 'ftp-error' belongs also to category 'remote-file-error'. -+++ ** The WHEN argument of 'make-obsolete' and related functions is mandatory. The use of those functions without a WHEN argument was marked obsolete back in Emacs 23.1. The affected functions are: 'make-obsolete', 'define-obsolete-function-alias', 'make-obsolete-variable', 'define-obsolete-variable-alias'. -+++ ** 'inhibit-nul-byte-detection' is renamed to 'inhibit-null-byte-detection'. ---- ** Some functions are no longer considered safe by 'unsafep': 'replace-regexp-in-string', 'catch', 'throw', 'error', 'signal' and 'play-sound-file'. ---- ** 'sql-*-statement-starters' are no longer user options. These variables describe facts about the SQL standard and product-specific additions. There should be no need for users to customize them. ---- ** Some locale-related variables have been removed. The Lisp variables 'previous-system-messages-locale' and 'previous-system-time-locale' have been removed, as they were created by mistake and were not useful to Lisp code. ---- ** Function 'lm-maintainer' is replaced with 'lm-maintainers'. The former is now declared obsolete. -+++ ** facemenu.el is no longer preloaded. To use functions/variables from the package, you now have to say '(require 'facemenu)' or similar. ---- ** 'facemenu-color-alist' is now obsolete, and is not used. ---- ** The variable 'keyboard-type' is obsolete and not dynamically scoped any more. -+++ ** The 'values' variable is now obsolete. Using it just contributes to the growth of the Emacs memory footprint. ---- ** The 'load-dangerous-libraries' variable is now obsolete. It was used to allow loading Lisp libraries compiled by XEmacs, a modified version of Emacs which is no longer actively maintained. This is no longer supported, and setting this variable has no effect. -+++ ** The macro 'with-displayed-buffer-window' is now obsolete. Use macro 'with-current-buffer-window' with action alist entry 'body-function'. ---- ** The rfc2368.el library is now obsolete. Use rfc6068.el instead. The main difference is that 'rfc2368-parse-mailto-url' and 'rfc2368-unhexify-string' assumed that the strings were all-ASCII, while 'rfc6068-parse-mailto-url' and 'rfc6068-unhexify-string' parse UTF-8 strings. ---- ** The inversion.el library is now obsolete. ---- ** The metamail.el library is now obsolete. ** Edebug changes ---- *** 'get-edebug-spec' is obsolete, replaced by 'edebug-get-spec'. -+++ *** The spec operator ':name NAME' is obsolete, use '&name' instead. -+++ *** The spec element 'function-form' is obsolete, use 'form' instead. -+++ *** New function 'def-edebug-elem-spec' to define Edebug spec elements. These used to be defined with 'def-edebug-spec' thus conflating the two name spaces, which lead to name collisions. The use of 'def-edebug-spec' to define Edebug spec elements is declared obsolete. ---- ** The sb-image.el library is now obsolete. This was a compatibility kludge which is no longer needed. ---- ** Some libraries obsolete since Emacs 23 have been removed: ledit.el, lmenu.el, lucid.el and old-whitespace.el. ---- ** Some functions and variables obsolete since Emacs 23 have been removed: 'GOLD-map', 'advertised-xscheme-send-previous-expression', 'allout-init', 'bookmark-jump-noselect', @@ -3675,20 +3144,16 @@ ledit.el, lmenu.el, lucid.el and old-whitespace.el. 'vcursor-toggle-vcursor-map', 'w32-focus-frame', 'w32-select-font', 'wisent-lex-make-token-table'. ---- ** Some functions and variables obsolete since Emacs 22 have been removed: 'erc-current-network', 'gnus-article-hide-pgp-hook', 'gnus-inews-mark-gcc-as-read', 'gnus-treat-display-xface', 'gnus-treat-strip-pgp', 'nnmail-spool-file'. ---- ** The obsolete function 'thread-alive-p' has been removed. ---- ** The variable 'force-new-style-backquotes' has been removed. This removes the final remaining trace of old-style backquotes. ---- ** Some obsolete variable and function aliases in dbus.el have been removed. In Emacs 24.3, the variable 'dbus-event-error-hooks' was renamed to 'dbus-event-error-functions' and the function @@ -3696,7 +3161,6 @@ In Emacs 24.3, the variable 'dbus-event-error-hooks' was renamed to The old names, which were kept as obsolete aliases of the new names, have now been removed. ---- ** 'find-function-source-path' renamed and re-documented. The 'find-function' command (and various related commands) were documented to respect 'find-function-source-path', and to search for @@ -3709,7 +3173,6 @@ still being used by 'find-library' and related commands, so the user option has been renamed to 'find-library-source-path', and 'find-function-source-path' is now an obsolete variable alias. ---- ** The macro 'vc-call' no longer evaluates its second argument twice. ** Xref migrated from EIEIO to 'cl-defstruct' for its core objects. @@ -3729,7 +3192,6 @@ use with "match items" without adding EIEIO as a dependency. * Lisp Changes in Emacs 28.1 -+++ ** The 'interactive' syntax has been extended to allow listing applicable modes. Forms like '(interactive "p" dired-mode)' can be used to annotate the commands as being applicable for modes derived from 'dired-mode', @@ -3740,7 +3202,6 @@ Also note that by default these annotations have no effect, unless the 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'. '(declare (completion PREDICATE))' can be used as a general predicate to say whether the command should be considered a completion candidate @@ -3759,74 +3220,61 @@ 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. 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. -+++ ** 'define-derived-mode' now takes an ':interactive' argument. This can be used to control whether the defined mode is a command or not, and is useful when defining commands that aren't meant to be used by users directly. -+++ ** 'define-globalized-minor-mode' now takes a ':predicate' parameter. This can be used to control which major modes the minor mode should be used in. -+++ ** 'condition-case' now allows for a success handler. It is written as '(:success BODY...)' where BODY is executed whenever the protected form terminates without error, with the specified variable bound to the value of the protected form. -+++ ** New function 'benchmark-call' to measure the execution time of a function. Additionally, the number of repetitions can be expressed as a minimal duration in seconds. -+++ ** The value thrown to the 'exit' label can now be a function. This is in addition to values t or nil. If the value is a function, the command loop will call it with zero arguments before returning. -+++ ** The behavior of 'format-spec' is now closer to that of 'format'. In order for the two functions to behave more consistently, 'format-spec' now pads and truncates based on string width rather than length, and also supports format specifications that include a truncating precision field, such as "%.2a". ---- ** 'defvar' detects the error of defining a variable currently lexically bound. Such mixes are always signs that the outer lexical binding was an error and should have used dynamic binding instead. ---- ** New variable 'inhibit-mouse-event-check'. If bound to non-nil, a command with '(interactive "e")' doesn't signal an error when invoked by input event that is not a mouse click (e.g., a key sequence). ---- ** New variable 'redisplay-skip-initial-frame' to enable batch redisplay tests. Setting it to nil forces the redisplay to do its job even in the initial frame used in batch mode. -+++ ** Doc strings can now link to customization groups. Text like "customization group `whitespace'" will be made into a button. When clicked, it will open a Custom buffer displaying that customization group. -+++ ** Doc strings can now link to man pages. Text like "man page `chmod(1)'" will be made into a button. When clicked, it will open a Man mode buffer displaying that man page. -+++ ** Buffers can now be created with certain hooks disabled. The functions 'get-buffer-create' and 'generate-new-buffer' accept a new optional argument INHIBIT-BUFFER-HOOKS. If non-nil, the new @@ -3835,78 +3283,63 @@ buffer does not run the hooks 'kill-buffer-hook', avoids slowing down internal or temporary buffers that are never presented to users or passed on to other applications. -+++ ** New command 'make-directory-autoloads'. 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 an explicit parameter. ---- ** Dragging a file into Emacs pushes the file name onto 'file-name-history'. ---- ** The 'easymenu' library is now preloaded. ---- ** The 'iso-transl' library is now preloaded. This means that keystrokes like 'Alt-[' are defined by default, instead of only becoming available after doing (for instance) 'C-x 8 <letter>'. ---- ** ':safe' settings in 'defcustom' are now propagated to the loaddefs files. -+++ ** New ':type' for 'defcustom' for nonnegative integers. The new 'natnum' type can be used for options that should be nonnegative integers. -+++ ** ERT can now output more verbose test failure reports. If the 'EMACS_TEST_VERBOSE' environment variable is set, failure summaries will include the failing condition. ** Byte compiler changes -+++ *** 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 Info node "(elisp) Converting to Lexical Binding". -+++ *** 'byte-recompile-directory' can now compile symlinked "*.el" files. This is achieved by giving a non-nil FOLLOW-SYMLINKS parameter. ---- *** The byte-compiler now warns about too wide documentation strings. By default, it will warn if a documentation string is wider than the largest of 'byte-compile-docstring-max-column' or 'fill-column' characters. -+++ *** 'byte-compile-file' optional argument LOAD is now obsolete. To load the file after byte-compiling, add a call to 'load' from Lisp or use 'M-x emacs-lisp-byte-compile-and-load' interactively. ** Macroexp ---- *** New function 'macroexp-file-name' to know the name of the current file. ---- *** New function 'macroexp-compiling-p' to know if we're compiling. ---- *** New function 'macroexp-warn-and-return' to help emit warnings. This used to be named 'macroexp--warn-and-return' and has proved useful and well-behaved enough to lose the "internal" marker. ** map.el ---- *** Alist keys are now consistently compared with 'equal' by default. Until now, 'map-elt' and 'map-delete' compared alist keys with 'eq' by default. They now use 'equal' instead, for consistency with @@ -3916,14 +3349,11 @@ default. They now use 'equal' instead, for consistency with A pattern like '(map :sym)' binds the map's value for ':sym' to 'sym', equivalent to '(map (:sym sym))'. ---- *** The function 'map-copy' now uses 'copy-alist' on alists. This is a slightly deeper copy than the previous 'copy-sequence'. ---- *** The function 'map-contains-key' now supports plists. ---- *** More consistent duplicate key handling in 'map-merge-with'. Until now, 'map-merge-with' promised to call its function argument whenever multiple maps contained 'eql' keys. However, this did not @@ -3933,26 +3363,21 @@ are merged, for greater consistency with 'map-merge' and 'map-elt'. ** Pcase -+++ *** The 'or' pattern now binds the union of the vars of its sub-patterns. If a variable is not bound by the subpattern that matched, it gets bound to nil. This was already sometimes the case, but it is now guaranteed. -+++ *** The 'pred' pattern can now take the form '(pred (not FUN))'. This is like '(pred (lambda (x) (not (FUN x))))' but results in better code. ---- *** New function 'pcase-compile-patterns' to write other macros. -+++ *** Added 'cl-type' pattern. The new 'cl-type' pattern compares types using 'cl-typep', which allows comparing simple types like '(cl-type integer)', as well as forms like '(cl-type (integer 0 10))'. -+++ *** New macro 'pcase-setq'. This macro is the 'setq' equivalent of 'pcase-let', which allows for destructuring patterns in a 'setq' form. @@ -3961,49 +3386,40 @@ 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 PF is a parsing function that expects a single argument (the specs to use) and HEAD is the code that matched SPEC. -+++ **** '&error MSG' unconditionally aborts the current edebug instrumentation. -+++ **** '&name SPEC FUN' extracts the current name from the code matching SPEC. ** Dynamic modules changes -+++ *** Type aliases for module functions and finalizers. The module header "emacs-module.h" now contains type aliases 'emacs_function' and 'emacs_finalizer' for module functions and finalizers, respectively. -+++ *** Module functions can now be made interactive. Use 'make_interactive' to give a module function an interactive specification. -+++ *** Module functions can now install an optional finalizer. The finalizer is called when the function object is garbage-collected. Use 'set_function_finalizer' to set the finalizer and 'get_function_finalizer' to retrieve it. -+++ *** Modules can now open a channel to an existing pipe process. Modules can use the new module function 'open_channel' to do that. On capable systems, modules can use this functionality to asynchronously send data back to Emacs. -+++ *** A new module API 'make_unibyte_string'. It can be used to create Lisp strings with arbitrary byte sequences (a.k.a. "raw bytes"). -+++ ** Shorthands for Lisp symbols. Shorthands are a general purpose namespacing system to make Emacs Lisp's symbol-naming etiquette easier to use. A shorthand is any @@ -4014,230 +3430,182 @@ worth of symbols with proper and longer prefixes, without actually touching the Lisp source. For details, see the Info node "(elisp) Shorthands". -+++ ** New function 'string-search'. This function takes two string parameters and returns the position of the first instance of the former string in the latter. -+++ ** New function 'string-replace'. This function works along the line of 'replace-regexp-in-string', but it matches on fixed strings instead of regexps, and does not change the global match state. -+++ ** New function 'ensure-list'. This function makes a list of its object if it's not a list already. If it's already a list, the list is returned as is. -+++ ** New function 'split-string-shell-command'. This splits a shell command string into separate components, respecting quoting with single ('like this') and double ("like this") quotes, as well as backslash quoting (like\ this). -+++ ** New function 'string-clean-whitespace'. This removes whitespace from a string. -+++ ** New function 'string-fill'. Word-wrap a string so that no lines are longer that a specific length. -+++ ** New function 'string-limit'. Return (up to) a specific substring length. -+++ ** New function 'string-lines'. Return a list of strings representing the individual lines in a string. -+++ ** New function 'string-pad'. Pad a string to a specific length. -+++ ** New function 'string-chop-newline'. Remove a trailing newline from a string. -+++ ** New function 'replace-regexp-in-region'. -+++ ** New function 'replace-string-in-region'. -+++ ** New function 'file-name-with-extension'. This function allows a canonical way to set/replace the extension of a file name. -+++ ** New function 'file-modes-number-to-symbolic' to convert a numeric file mode specification into symbolic form. -+++ ** New function 'file-name-concat'. This appends file name components to a directory name and returns the result. -+++ ** New function 'file-backup-file-names'. This function returns the list of file names of all the backup files for the specified file. -+++ ** New function 'directory-empty-p'. This predicate tests whether a given file name is an accessible directory and whether it contains no other directories or files. -+++ ** New function 'buffer-local-boundp'. This predicate says whether a symbol is bound in a specific buffer. -+++ ** New function 'always'. This is identical to 'ignore', but returns t instead. -+++ ** New function 'sxhash-equal-including-properties'. This is identical to 'sxhash-equal' but also accounts for string properties. ---- ** New function 'buffer-line-statistics'. This function returns some statistics about the line lengths in a buffer. ---- ** New function 'color-values-from-color-spec'. This can be used to parse RGB color specs in several formats and convert them to a list '(R G B)' of primary color values. ---- ** New function 'custom-add-choice'. This function can be used by modes to add elements to the 'choice' customization type of a variable. ---- ** New function 'decoded-time-period'. It interprets a decoded time structure as a period and returns the equivalent period in seconds. -+++ ** New function 'dom-print'. -+++ ** New function 'dom-remove-attribute'. ---- ** New function 'dns-query-asynchronous'. It takes the same parameters as 'dns-query', but adds a callback parameter. ** New function 'garbage-collect-maybe' to trigger GC early. ---- ** New function 'get-locale-names'. This utility function returns a list of names of locales available on the current system. -+++ ** New function 'insert-into-buffer'. This inserts the contents of the current buffer into another buffer. -+++ ** New function 'json-available-p'. This predicate returns non-nil if Emacs is built with libjansson support, and it is available on the current system. ---- ** New function 'mail-header-parse-addresses-lax'. This takes a comma-separated string and returns a list of mail/name pairs. ---- ** New function 'mail-header-parse-address-lax'. Parse a string as a mail address-like string. ---- ** New function 'make-separator-line'. Make a string appropriate for usage as a visual separator line. -+++ ** New function 'num-processors'. Return the number of processors on the system. -+++ ** New function 'object-intervals'. This function returns a copy of the list of intervals (i.e., text properties) in the object in question (which must either be a string or a buffer). -+++ ** New function 'process-lines-ignore-status'. This is like 'process-lines', but does not signal an error if the return status is non-zero. 'process-lines-handling-status' has also been added, and takes a callback to handle the return status. -+++ ** New function 'require-theme'. This function is like 'require', but searches 'custom-theme-load-path' instead of 'load-path'. It can be used by Custom themes to load supporting Lisp files when 'require' is unsuitable. -+++ ** New function 'seq-union'. This function takes two sequences and returns a list of all elements that appear in either of them, with no two elements that compare equal appearing in the result. -+++ ** New function 'syntax-class-to-char'. This does almost the opposite of 'string-to-syntax' -- it returns the syntax descriptor (a character) given a raw syntax descriptor (an integer). -+++ ** New functions 'null-device' and 'path-separator'. These functions return the connection local value of the respective variables. This can be used for remote hosts. -+++ ** New predicate functions 'length<', 'length>' and 'length='. Using these functions may be more efficient than using 'length' (if the length of a (long) list is being computed just to compare this length to a number). -+++ ** New macro 'dlet' to dynamically bind variables. -+++ ** New macro 'with-existing-directory'. This macro binds 'default-directory' to some other existing directory if 'default-directory' doesn't exist, and then executes the body forms. -+++ ** New variable 'current-minibuffer-command'. This is like 'this-command', but it is bound recursively when entering the minibuffer. -+++ ** New variable 'inhibit-interaction' to make user prompts signal an error. If this is bound to something non-nil, functions like 'read-from-minibuffer', 'read-char' (and related) will signal an 'inhibited-interaction' error. ---- ** New variable 'indent-line-ignored-functions'. This allows modes to cycle through a set of indentation functions appropriate for those modes. -+++ ** New variable 'print-integers-as-characters' modifies integer printing. If this variable is non-nil, character syntax is used for printing numbers when this makes sense, such as '?A' for 65. -+++ ** New variable 'tty-menu-calls-mouse-position-function'. This controls whether 'mouse-position-function' is called by functions that retrieve the mouse position when that happens during TTY menu @@ -4245,46 +3613,38 @@ handling. Lisp programs that set 'mouse-position-function' should also set this variable non-nil if they are compatible with the tty menu handling. -+++ ** New variables that hold default buffer names for shell output. The new constants 'shell-command-buffer-name' and 'shell-command-buffer-name-async' store the default buffer names for the output of, respectively, synchronous and async shell commands. ---- ** New variables 'read-char-choice-use-read-key' and 'y-or-n-p-use-read-key'. When non-nil, then functions 'read-char-choice' and 'y-or-n-p' (respectively) use the function 'read-key' to read a character instead of using the minibuffer. -+++ ** New variable 'global-minor-modes'. This variable holds a list of currently enabled global minor modes (as a list of symbols). -+++ ** New buffer-local variable 'local-minor-modes'. This permanently buffer-local variable holds a list of currently enabled non-global minor modes in the current buffer (as a list of symbols). -+++ ** New completion function 'affixation-function' to add prefix/suffix. It accepts a list of completions and should return a list where each element is a list with three elements: a completion, a prefix string, and a suffix string. -+++ ** New completion function 'group-function' for grouping candidates. It takes two arguments: a completion candidate and a 'transform' flag. -+++ ** New error symbol 'minibuffer-quit'. Signaling it has almost the same effect as 'quit' except that it doesn't cause keyboard macro termination. -+++ ** 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' @@ -4298,11 +3658,9 @@ Until it is solved you could ignore such errors by performing (setq debug-ignored-errors (cons 'remote-file-error debug-ignored-errors)) -+++ ** New macro 'named-let'. It provides Scheme's "named let" looping construct. ---- ** Emacs now attempts to test for high-rate subprocess output more fairly. When several subprocesses produce output simultaneously at high rate, Emacs will now by default attempt to service them all in a round-robin @@ -4311,81 +3669,66 @@ non-nil value to get back the old behavior, whereby after reading from a subprocess, Emacs would check for output of other subprocesses in a way that is likely to read from the same process again. -+++ ** 'set-process-buffer' now updates the process mark. The mark will be set to point to the end of the new buffer. -+++ ** 'unlock-buffer' displays warnings instead of signaling. Instead of signaling 'file-error' conditions for file system level errors, the function now calls 'display-warning' and continues as if the error did not occur. -+++ ** 'read-char-from-minibuffer' and 'y-or-n-p' support 'help-form'. If you bind 'help-form' to a non-nil value while calling these functions, then pressing 'C-h' ('help-char') causes the function to evaluate 'help-form' and display the result. -+++ ** 'read-number' now has its own 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 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. ---- ** 'count-windows' now takes an optional parameter ALL-FRAMES. The semantics are as with 'walk-windows'. -+++ ** 'truncate-string-ellipsis' now uses '…' by default. Modes that use 'truncate-string-to-width' with non-nil, non-string argument ELLIPSIS, will now indicate truncation using '…' when the selected frame can display it, and using "..." otherwise. -+++ ** 'string-width' now accepts two optional arguments FROM and TO. This allows calculating the width of a substring without consing a new string. -+++ ** 'directory-files' now takes an additional COUNT parameter. The parameter makes 'directory-files' return COUNT first file names from a directory. If MATCH is also given, the function will return first COUNT file names that match the expression. The same COUNT parameter has been added to 'directory-files-and-attributes'. -+++ ** 'count-lines' can now ignore invisible lines. This is controlled by the optional parameter IGNORE-INVISIBLE-LINES. ---- ** 'count-words' now crosses field boundaries. Originally, 'count-words' would stop counting at the first field boundary it encountered; now it keeps counting all the way to the region's (or buffer's) end. -+++ ** File-related APIs can optionally follow symlinks. The functions 'file-modes', 'set-file-modes', and 'set-file-times' now have an optional argument specifying whether to follow symbolic links. -+++ ** 'format-seconds' can now be used for sub-second times. The new optional "," parameter has been added, and '(format-seconds "%mm %,1ss" 66.4)' will now result in "1m 6.4s". -+++ ** 'parse-time-string' can now parse ISO 8601 format strings. These have a format like "2020-01-15T16:12:21-08:00". ---- ** 'lookup-key' is more allowing when searching for extended menu items. When looking for a menu item '[menu-bar Foo-Bar]', first try to find an exact match, then look for the lowercased '[menu-bar foo-bar]'. @@ -4393,7 +3736,6 @@ It will only try to downcase ASCII characters in the range "A-Z". This improves backwards-compatibility when converting menus to use 'easy-menu-define'. ---- ** 'make-network-process', 'make-serial-process' ':coding' behavior change. Previously, passing ':coding nil' to either of these functions would override any non-nil binding for 'coding-system-for-read' and @@ -4403,92 +3745,73 @@ Emacs depended on the previous behavior; if you really want the process' coding-system to be nil, use 'set-process-coding-system' after the process has been created, or pass in ':coding '(nil nil)'. -+++ ** 'open-network-stream' now accepts a ':coding' argument. This allows specifying the coding systems used by a network process for encoding and decoding without having to bind 'coding-system-for-{read,write}' or call 'set-process-coding-system'. -+++ ** 'open-network-stream' can now take a ':capability-command' that's a function. The function is called with the greeting from the server as its only parameter, and allows sending different TLS capability commands to the server based on that greeting. -+++ ** 'open-gnutls-stream' now also accepts a ':coding' argument. ---- ** 'process-attributes' now works under OpenBSD, too. -+++ ** 'format-spec' now takes an optional SPLIT parameter. If non-nil, 'format-spec' will split the resulting string into a list of strings, based on where the format specs (and expansions) were. ---- ** 'unload-feature' now also tries to undo additions to buffer-local hooks. ---- ** 'while-no-input-ignore-events' accepts more special events. The special events 'dbus-event' and 'file-notify' are now ignored in 'while-no-input' when added to this variable. ---- ** 'start-process-shell-command' and 'start-file-process-shell-command' do not support the old calling conventions any longer. -+++ ** 'yes-or-no-p' and 'y-or-n-p' PROMPT parameter no longer needs trailing space. In other words, the prompt can now end with "?" instead of "? ". This 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. 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 risk of excessively long file names. -+++ ** New user option 'process-file-return-signal-string'. It controls, whether 'process-file' returns a string when a remote process is interrupted by a signal. ** EIEIO Changes -+++ *** The macro 'oref-default' can now be used with 'setf'. It is now defined as a generalized variable that can be used with 'setf' to modify the value stored in a given class slot. ---- *** 'form' in '(eql form)' specializers in 'cl-defmethod' is now evaluated. This corresponds to the behavior of defmethod in Common Lisp Object System. For compatibility, '(eql SYMBOL)' does not evaluate SYMBOL, for now. ** D-Bus -+++ *** Property values can be typed explicitly. 'dbus-register-property' and 'dbus-set-property' accept now optional type symbols. Both functions propagate D-Bus errors. -+++ *** Registered properties can have the new access type ':write'. -+++ *** In case of problems, handlers can emit proper D-Bus error messages now. -+++ *** D-Bus errors, which have been converted from incoming D-Bus error messages, contain the error name of that message now. -+++ *** D-Bus messages can be monitored with the new command 'dbus-monitor'. -+++ *** D-Bus events have changed their internal structure. They carry now the destination and the error-name of an event. They also keep the type information of their arguments. Use the @@ -4496,19 +3819,16 @@ also keep the type information of their arguments. Use the ** Buttons -+++ *** New minor mode 'button-mode'. This minor mode does nothing except install 'button-buffer-map' as a minor mode map (which binds the 'TAB' / 'S-TAB' key bindings to navigate to buttons), and can be used in any view-mode-like buffer that has buttons in it. -+++ *** New utility function 'button-buttonize'. This function takes a string and returns a string propertized in a way that makes it a valid button. ---- ** 'text-scale-mode' can now adjust font size of the header line. When the new buffer local variable 'text-scale-remap-header-line' is non-nil, 'text-scale-adjust' will also scale the text in the header @@ -4519,10 +3839,8 @@ form below the header line. It is enabled by default in 'tabulated-list-mode' and its derived modes, and disabled by default elsewhere. ---- ** 'ascii' is now a coding system alias for 'us-ascii'. ---- ** New coding-systems for EBCDIC variants. New coding-systems 'ibm256', 'ibm273', 'ibm274', 'ibm277', 'ibm278', 'ibm280', 'ibm281', 'ibm284', 'ibm285', 'ibm290', 'ibm297'. These are @@ -4532,14 +3850,12 @@ locales. They are also available as aliases 'ebcdic-cp-*' (e.g., 'cp278' for 'ibm278'). There are also new charsets 'ibm2xx' to support these coding-systems. -+++ ** 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 "(elisp) Byte Packing" in the ELisp manual for more details. -+++ ** New macro 'with-environment-variables'. This macro allows setting environment variables temporarily when executing a form. @@ -4547,7 +3863,6 @@ executing a form. * Changes in Emacs 28.1 on Non-Free Operating Systems -+++ ** On MS-Windows, Emacs can now use the native image API to display images. Emacs can now use the MS-Windows GDI+ library to load and display images in JPEG, PNG, GIF and TIFF formats. This support is available @@ -4558,7 +3873,6 @@ To turn this on, set the variable 'w32-use-native-image-API' to a non-nil value. Please report any bugs you find while using the native image API via 'M-x report-emacs-bug'. -+++ ** On MS-Windows, Emacs can now toggle the IME. A new function 'w32-set-ime-open-status' can now be used to disable and enable the MS-Windows native Input Method Editor (IME) at run @@ -4570,26 +3884,21 @@ current IME activation status. 'move-beginning-of-line' and 'move-end-of-line' respectively. The commands to select previous/next frame are still bound to 's-~' and 's-`'. -+++ ** On macOS, Emacs can now load dynamic modules with a ".dylib" suffix. 'module-file-suffix' now has the value ".dylib" on macOS, but the ".so" suffix is supported as well. ---- ** On macOS, the user option 'make-pointer-invisible' is now honored. ---- ** On macOS, Xwidget is now supported. If Emacs was built with xwidget support, you can access the embedded webkit browser with command 'xwidget-webkit-browse-url'. Viewing two instances of xwidget webkit is not supported. ---- *** New user option 'xwidget-webkit-enable-plugins'. If non-nil, enable plugins in xwidget. (This is only available on macOS.) -+++ ** New macOS Contacts back-end for EUDC. This backend works on newer versions of macOS and is generally preferred over the eudcb-mab.el backend. diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS index e4bb706e08c..37a39131d93 100644 --- a/etc/ORG-NEWS +++ b/etc/ORG-NEWS @@ -451,10 +451,6 @@ you can now configure them. (the default) or use the attachment directory of the current node, if it is correctly configured as a Git repository. -*** Some faces now use fixed-pitch - -See [[msg:875z8njaol.fsf@protesilaos.com][this thread]]. - *** New option ~org-attach-sync-delete-empty-dir~ ~org-attach-sync-delete-empty-dir~ controls the deletion of an empty @@ -509,7 +505,7 @@ heading, except return nil. In the past, faces of todo keywords, emphasised text, tags, and priority cookies inherited =default= face. The resulting headline -fontification was not always consistent, as discussed in [[https://lists.gnu.org/archive/html/emacs-orgmode/2020-09/msg00331.html][this bug +fontification was not always consistent, as discussed in [[msg::87h7sawubl.fsf@protesilaos.com][this bug report]]. Now, the relevant faces adapt to face used to fontify the current headline level. diff --git a/etc/PROBLEMS b/etc/PROBLEMS index 25022cad463..270de600d66 100644 --- a/etc/PROBLEMS +++ b/etc/PROBLEMS @@ -651,6 +651,46 @@ And then rename the system's readline so that it won't be loaded: See <https://pypi.python.org/pypi/gnureadline> for more details on installation. +*** On MS-Windows, invoking "M-x run-python" signals an error. + +If the error says something like this: + + Python was not found; run with arguments to install + from the Microsoft Store, or disable this shortcut + from Settings > Manage App Execution Aliases. + + Process Python exited abnormally with code 49 + +then this is due to the MS-Windows "feature" that is intended to +encourage you to install the latest available Python version. It +works by placing "fake" python.exe and python3.exe executables in a +special directory, and having that directory on your Path _before_ the +directory where the real Python executable is installed. That "fake" +Python then decides whether to redirect you to the Microsoft Store or +invoke the actual Python. The directory where Windows keeps those +"fake" executables is under your Windows user's 'AppData' directory, +typically 'C:\Users\<user>\AppData\Local\Microsoft\WindowsApps', where +"<user>" is the user name of your Windows user. + +To solve this, you have several alternatives: + + . Go to "Settings > Manage App Execution Aliases" and turn OFF the + aliases for python.exe and/or python3.exe. This will affect only + Python, and may require you to manage upgrades to your Python + installation manually, instead of being automatically prompted by + MS-Windows. + . Move the directory with the "fake" executables to the end of Path, + or at least after the directory where the real Python is + installed. Depending on the position in Path where you move it, + it will affect Python and/or other programs which Windows monitors + via the "App Execution Aliases" feature. + . Manually remove python.exe and/or python3.exe from the above + directory. Again, this affects only your Python installation. + +Whatever you do, you will need to restart Emacs to refresh its notion +of the directory where python.exe/python3.exe lives, because that is +recorded when Python mode is started. + *** Visiting files in some auto-mounted directories causes Emacs to print 'Error reading dir-locals: (file-error "Read error" "is a directory" ...' @@ -1009,6 +1049,15 @@ index 5504171..431adf8 100644 If you can't modify that file directly, copy it to the directory ~/.m17n.d/ (create it if it doesn't exist), and apply the patch. +** On Haiku, some proportionally-spaced fonts display with artifacting. + +This is a Haiku bug: https://dev.haiku-os.org/ticket/17229, which can +be remedied by using a different font that does not exhibit this +problem, or by configuring Emacs '--with-be-cairo'. + +So far, Bitstream Charter and Noto Sans have been known to exhibit +this problem, while Noto Sans Display is known to not do so. + ** On MS-Windows, some characters display as boxes with hex code. Also, some characters could display with wrong fonts. @@ -1022,14 +1071,20 @@ modern fonts are used, such as Noto Emoji or Ebrima. The solution is to switch to a configuration that uses HarfBuzz as its shaping engine, where these problems don't exist. -** On Haiku, some proportionally-spaced fonts display with artifacting. +** On MS-Windows, selecting some fonts as the default font doesn't work. -This is a Haiku bug: https://dev.haiku-os.org/ticket/17229, which can -be remedied by using a different font that does not exhibit this -problem, or by configuring Emacs '--with-be-cairo'. +This can happen if you select font variants such as "Light" or "Thin" +or "Semibold" or "Heavy", and some others. The APIs used by Emacs on +Windows to enumerate fonts in a font family consider only 4 font +variants to belong to the same family: Regular, Italic, Bold, and +Bold-Italic. All the other variants aren't returned by those APIs +when we request to list all the fonts in a family, and thus aren't +considered by Emacs to belong to the family. So any font variant that +is not one of those 4 will likely not work as expected; in most cases +Emacs will select some other font instead. -So far, Bitstream Charter and Noto Sans have been known to exhibit -this problem, while Noto Sans Display is known to not do so. +The only workaround is not to choose such font variants as the default +font when running Emacs on MS-Windows. * Internationalization problems @@ -1796,7 +1851,7 @@ your X defaults file to avoid the problem: XTerm.*.allowSendEvents: True -Note that this can in theory pose a security risk, but in pratice +Note that this can in theory pose a security risk, but in practice modern X servers have so many other ways to send input to clients without signifying that the event is synthesized that it does not matter. diff --git a/etc/images/gnus/catchup.pbm b/etc/images/gnus/catchup.pbm Binary files differdeleted file mode 100644 index 3fc571bdf80..00000000000 --- a/etc/images/gnus/catchup.pbm +++ /dev/null diff --git a/etc/images/gnus/catchup.xpm b/etc/images/gnus/catchup.xpm deleted file mode 100644 index cba849712df..00000000000 --- a/etc/images/gnus/catchup.xpm +++ /dev/null @@ -1,33 +0,0 @@ -/* XPM */ -static char * catchup_xpm[] = { -"24 24 6 1", -" c None", -". c #FFFFFFFFFFFF", -"X c #E1E1E0E0E0E0", -"o c #A5A5A5A59595", -"O c #999999999999", -"+ c #000000000000", -" ", -" ", -" ", -" ", -" ", -" ", -" ", -" . ", -" . .X ", -" ... .oX . ", -" ..oooX.oXo .X ", -" .oooXXXX..oXXoXX ", -" .oXXXX.XoX.oXooX ", -" X...X.X.XX.XoXX ", -" Xo..X.XXX.XXXX ", -" . Xo.oXX..XXXXXX ", -"OOOOXoXXXXXo.XXXXX++OOOO", -"OOOOOX..X.XXXXXXXX++OOOO", -"OOOOOX..XXXXXXXXX++OOOOO", -"OOOOOOXXXXXXXXX+++OOOOOO", -"OOOOOOOOOXXXX++++OOOOOOO", -"OOOOOOOOO+++++OOOOOOOOOO", -"OOOOOOOOOO+OOOOOOOOOOOOO", -"OOOOOOOOOOOOOOOOOOOOOOOO"}; diff --git a/etc/images/gnus/cu-exit.pbm b/etc/images/gnus/cu-exit.pbm Binary files differdeleted file mode 100644 index 210869cce78..00000000000 --- a/etc/images/gnus/cu-exit.pbm +++ /dev/null diff --git a/etc/images/gnus/cu-exit.xpm b/etc/images/gnus/cu-exit.xpm deleted file mode 100644 index 17236223fed..00000000000 --- a/etc/images/gnus/cu-exit.xpm +++ /dev/null @@ -1,31 +0,0 @@ -/* XPM */ -static char * cu_exit_xpm[] = { -"24 24 4 1", -" c None", -". c #000000000000", -"X c #FFFFFFFFFFFF", -"o c #999999999999", -" ", -" ", -" ", -" ", -" ", -" ..... ", -" .. .XXX. ", -" ..X..XXXX... ", -" .XXXX.XXXX.X... ", -" ..XXXX.XXX.XXX.. ", -" .XXX.......... ", -" .XXX.XXX.XXX.. ", -" .XX.XXX.XXX. ", -" .XX.XXX.XX.. ", -" ............ ", -" .X.X.X.X.. ", -"ooooooo..........ooooooo", -"ooooooo.X.X.X.X.oooooooo", -"ooooooo.........oooooooo", -"ooooooo..X...X..oooooooo", -"ooooooo...X.X...oooooooo", -"ooooooo........ooooooooo", -"ooooooooo.....oooooooooo", -"oooooooooooooooooooooooo"}; diff --git a/etc/images/gnus/describe-group.pbm b/etc/images/gnus/describe-group.pbm Binary files differdeleted file mode 100644 index de7bf110431..00000000000 --- a/etc/images/gnus/describe-group.pbm +++ /dev/null diff --git a/etc/images/gnus/describe-group.xpm b/etc/images/gnus/describe-group.xpm deleted file mode 100644 index b4a6f42a94b..00000000000 --- a/etc/images/gnus/describe-group.xpm +++ /dev/null @@ -1,32 +0,0 @@ -/* XPM */ -static char * describe_group_xpm[] = { -"24 24 5 1", -". c None", -" c #000000000000", -"o c #FFFFF5F5ACAC", -"+ c #E1E1E0E0E0E0", -"@ c #C7C7C6C6C6C6", -"........................", -"........................", -".................oooo...", -" .. .. .. .. .. oo oo o.", -"..............oooooooooo", -".............ooooooooooo", -" .. .. .. .. oo oo oo oo", -"............oooooooooooo", -"............oooooooooooo", -" .. .. .. .. oo oo oo oo", -"............oooooooooooo", -"............oooooooooooo", -" .. .. .. .. oo oo oo oo", -"............oooooooooooo", -"..... ...oooooooooooo", -" .. ++ .. .o oo oo oo", -"... @@@+ ....ooooooooo", -"... @ ....oooooooo.", -" . . .. .. .. ..", -". ..............", -" ................", -" .. .. .. .. .. ..", -" ..................", -" ...................."}; diff --git a/etc/images/gnus/exit-gnus.pbm b/etc/images/gnus/exit-gnus.pbm Binary files differdeleted file mode 100644 index 32ad0e0ebe9..00000000000 --- a/etc/images/gnus/exit-gnus.pbm +++ /dev/null diff --git a/etc/images/gnus/exit-gnus.xpm b/etc/images/gnus/exit-gnus.xpm deleted file mode 100644 index 534f3c2fafb..00000000000 --- a/etc/images/gnus/exit-gnus.xpm +++ /dev/null @@ -1,33 +0,0 @@ -/* XPM */ -static char * exit_gnus_xpm[] = { -"24 24 6 1", -" c None", -". c #8686ADAD7D7D", -"X c #919187876969", -"o c #C2C2B9B99C9C", -"O c #A8A8F0F0ECEC", -"+ c #EFEFEFEFEFEF", -" ", -" .... . ", -" .. .. . ", -" ............. ", -" . . . .... ", -" ............. ", -" .............. .. ", -" . . .......... . ", -" .XXXX... .. ", -" o.XXX. . .. ", -" oo.X. .. ... ", -" ooX. . ... ", -" oXo. .. ", -" ooX . . ", -" ooX ", -"OOOOoXXOOOOOOOOOOOOOOOOO", -"OOOoXoXOOOOOOOOOOOOOOOOO", -"OOOooXXOOOO+OOOOOOOOOOOO", -"O+OoooXOO+OOO+OO+OOO+OOO", -"OXXoXoXoXOO++O++OO++OO+O", -"XXXXXXXXXXXX+OOOOOOOOOOO", -"XXXXXXXXXXXXXX+O++OO++OO", -"XXXXXXXXXXXXXXXXOOOOOOOO", -"O++O++++O+OO++OOOO++OOO+"}; diff --git a/etc/images/gnus/exit-summ.pbm b/etc/images/gnus/exit-summ.pbm Binary files differdeleted file mode 100644 index d0192310607..00000000000 --- a/etc/images/gnus/exit-summ.pbm +++ /dev/null diff --git a/etc/images/gnus/exit-summ.xpm b/etc/images/gnus/exit-summ.xpm deleted file mode 100644 index 5234ccb11ec..00000000000 --- a/etc/images/gnus/exit-summ.xpm +++ /dev/null @@ -1,30 +0,0 @@ -/* XPM */ -static char * exit_summ_xpm[] = { -"24 24 3 1", -". c None", -" c #000000000000", -"X c #E1E1E0E0E0E0", -" .. .. .. .. .. .. .. ..", -"........................", -"........................", -" .. .. .. ..", -"...... XXXX .....", -"...... XXXXXXX .....", -" .. .. XX XX XX .. ..", -"...... XXXXXXXX .....", -"...... XXXXXXX .....", -" .. .. X XX .. ..", -"...... XXXX .....", -"...... XXXX .....", -" .. .. X XXXXX .. ..", -"...... XXXXXXX .....", -"...... XXXXX XX .....", -" .. .. X XXXXX .. ..", -"...... XXXXX .....", -"...... X .....", -" .. . . .. ..", -"........................", -"........................", -" .. .. .. .. .. .. .. ..", -"........................", -"........................"}; diff --git a/etc/images/gnus/get-news.pbm b/etc/images/gnus/get-news.pbm Binary files differdeleted file mode 100644 index c0080716c44..00000000000 --- a/etc/images/gnus/get-news.pbm +++ /dev/null diff --git a/etc/images/gnus/get-news.xpm b/etc/images/gnus/get-news.xpm deleted file mode 100644 index d7e7b4a3553..00000000000 --- a/etc/images/gnus/get-news.xpm +++ /dev/null @@ -1,31 +0,0 @@ -/* XPM */ -static char * get_news_xpm[] = { -"24 24 4 1", -". c None", -"X c #A5A5A5A59595", -"o c #E1E1E0E0E0E0", -"O c #C7C7C6C6C6C6", -"........................", -"........................", -"........................", -".....XXX................", -"...XXoooXXXXX...........", -"XXXoooooXXoooX.XXX......", -"XoXooXXXooooXXXoooX.....", -"XooXoXoXooXXXoooooX.....", -"XooXXXooXoXoXooooooX....", -"XooXOXooXXXooXooooooX...", -"XoXOOXooXOXooXXooooooX..", -"OXOOOXoXOOXooXoooooooX..", -"OXOooOXOOOXoXOooooooooX.", -".OXooOXOooOXOOooooooooX.", -".OXoooOXooOXOooooooooooX", -"..OXooOXoooOXooooooooooX", -"..OXooOOXooOXooooooooooX", -"...OXooOXoooOXoooooooXXX", -"...OXooXOXooOXooooooXOO.", -"....OXXOOXooXOXoooXXO...", -".....OO..OXXOOXooXOO....", -"..........OO..OXXO......", -"...............OO.......", -"........................"}; diff --git a/etc/images/gnus/gnntg.pbm b/etc/images/gnus/gnntg.pbm Binary files differdeleted file mode 100644 index 2f5e5261a97..00000000000 --- a/etc/images/gnus/gnntg.pbm +++ /dev/null diff --git a/etc/images/gnus/gnntg.xpm b/etc/images/gnus/gnntg.xpm deleted file mode 100644 index 21bc5f16eb2..00000000000 --- a/etc/images/gnus/gnntg.xpm +++ /dev/null @@ -1,31 +0,0 @@ -/* XPM */ -static char * gnntg_xpm[] = { -"24 24 4 1", -" c None", -". c #000000000000", -"X c #FFFFFFFFFFFF", -"o c #C7C7C6C6C6C6", -" ", -" ....... ", -" .XXXXX. ", -" .XXXXX. ... ", -" .XXXXX... .ooo. ", -" .XXXXX.... ..ooo.. ", -" .XXXXX..o.. ..ooo.. ", -" .XXXXX...o.. ..o.. ", -" .XXXXX. ..o........ ", -" .XXXXX. ..oooooooo. ", -" ....... .oooooooo.. ", -" .ooooo..o. ", -" .oooo..o. ", -" .oooo..o. ", -" .oooo..o. ", -" .oooo..o. ", -" ......... ", -" ......oo. ", -" .ooooo... ", -" .oo..o... ", -" .oo..o.. ", -" ........ ", -" .... ... ", -" ... ... "}; diff --git a/etc/images/gnus/important.pbm b/etc/images/gnus/important.pbm Binary files differdeleted file mode 100644 index 7139ff2d69e..00000000000 --- a/etc/images/gnus/important.pbm +++ /dev/null diff --git a/etc/images/gnus/important.xpm b/etc/images/gnus/important.xpm deleted file mode 100644 index e972facff24..00000000000 --- a/etc/images/gnus/important.xpm +++ /dev/null @@ -1,32 +0,0 @@ -/* XPM */ -static char *magick[] = { -/* columns rows colors chars-per-pixel */ -"24 24 2 1", -"! c red", -"w c Gray75", -/* pixels */ -"wwwwwwwwwwwwwwwwwwwwwwww", -"wwwwwwwwwwwwwwwwwwwwwwww", -"wwwwwwwww!!!wwwwwwwwwwww", -"wwwwwwwww!!!wwwwwwwwwwww", -"wwwwwwww!!!!!wwwwwwwwwww", -"wwwwwwww!!!!!wwwwwwwwwww", -"wwwwwww!!!!!!!wwwwwwwwww", -"wwwwwww!!!!!!!wwwwwwwwww", -"wwwwwww!!!!!!!wwwwwwwwww", -"wwwwwww!!!!!!!wwwwwwwwww", -"wwwwwww!!!!!!!wwwwwwwwww", -"wwwwwww!!!!!!!wwwwwwwwww", -"wwwwwww!!!!!!!wwwwwwwwww", -"wwwwwwww!!!!!wwwwwwwwwww", -"wwwwwwww!!!!!wwwwwwwwwww", -"wwwwwwww!!!!!wwwwwwwwwww", -"wwwwwwwww!!!wwwwwwwwwwww", -"wwwwwwwwwwwwwwwwwwwwwwww", -"wwwwwwwww!!!wwwwwwwwwwww", -"wwwwwwww!!!!!wwwwwwwwwww", -"wwwwwwww!!!!!wwwwwwwwwww", -"wwwwwwwww!!!wwwwwwwwwwww", -"wwwwwwwwwwwwwwwwwwwwwwww", -"wwwwwwwwwwwwwwwwwwwwwwww" -}; diff --git a/etc/images/gnus/next-ur.pbm b/etc/images/gnus/next-ur.pbm Binary files differdeleted file mode 100644 index 678bbb09f8b..00000000000 --- a/etc/images/gnus/next-ur.pbm +++ /dev/null diff --git a/etc/images/gnus/next-ur.xpm b/etc/images/gnus/next-ur.xpm deleted file mode 100644 index bea13280b68..00000000000 --- a/etc/images/gnus/next-ur.xpm +++ /dev/null @@ -1,35 +0,0 @@ -/* XPM */ -static char * next_ur_xpm[] = { -"24 24 8 1", -". c None", -" c #000000000000", -"X c #A5A5A5A59595", -"o c #C7C7C6C6C6C6", -"O c #FFFF00000000", -"+ c #9A9A6C6C4E4E", -"@ c #E1E1E0E0E0E0", -"# c #FFFFFFFFFFFF", -" .. .. .. .. .. .. .. ..", -"........................", -"............X...........", -" .. .. .. .XXX. .. .. ..", -".........XXooOX.........", -".......XXooo+O@X........", -" .. XXXoooo++@@@X. .. ..", -"....X@Xoooooo@@@X.......", -"....X@@Xooo@@@@@@X......", -" .. X@@XXoo@@@@@@@X.. ..", -"....X@@Xoo@@@@@@@@@X....", -"....X@Xo@@@XX@@@@@@oX...", -" .. oXoo@XXooO@@@@@@X ..", -"....oXoXXooo+OX@@@@Xo...", -"....XXXoooo++@@X@@Xo....", -" .. X@Xoooooo@@@XX .. ..", -"....X@@Xooo@@@@@@X......", -"....X@@XXoo@@@@@@@X.....", -" .. X@@Xoo@@@@@@@@@X. ..", -"....X@Xo@ @@@@@@@ X...", -"... oXoo ## @@ @@ ## ...", -" .. oXo #### @ #### ..", -".....oX #### @@@ #### ..", -".....oX@ ## @@@@X ## ..."}; diff --git a/etc/images/gnus/post.pbm b/etc/images/gnus/post.pbm Binary files differdeleted file mode 100644 index 577d6236bfd..00000000000 --- a/etc/images/gnus/post.pbm +++ /dev/null diff --git a/etc/images/gnus/post.xpm b/etc/images/gnus/post.xpm deleted file mode 100644 index 7a3eaa5e3b1..00000000000 --- a/etc/images/gnus/post.xpm +++ /dev/null @@ -1,35 +0,0 @@ -/* XPM */ -static char * post_xpm[] = { -"24 24 8 1", -". c None", -" c #434343434343", -"X c #A5A5A5A59595", -"O c #000000000000", -"+ c #C7C7C6C6C6C6", -"@ c #FFFF00000000", -"# c #9A9A6C6C4E4E", -"$ c #E1E1E0E0E0E0", -"O..O..O..O..O..O..O..O..", -"........................", -"............X...........", -"O..O..O..O.XXX.O..O..O..", -".........XX++@X.........", -".......XX+++#@$X........", -"O..OXXX++++##$$$X.O..O..", -"....X$X++++++$$$X.......", -"....X$$X+++$$$$$$X......", -"O..OX$$XX++$$$$$$$X..O..", -"....X$$X++$$$$$$$$$X....", -"....X$X+$$$$$$$$$$$+X...", -"O..O+X++$$$$$$$$$$$$XO..", -"....+X+$$$$$$$$$$$$X+...", -".....+X$$$$$$$$$$$X+....", -"O..O.+X$$$$$$$$$XXO..O..", -"......+X$$$$$$$X++......", -"......+X$$$$$XX+........", -"O..O..O+X$$$X++O..O..O..", -".......+X$$X++..........", -"........+XX+............", -"O..O..O..O+.O..O..O..O..", -"........................", -"........................"}; diff --git a/etc/images/gnus/prev-ur.pbm b/etc/images/gnus/prev-ur.pbm Binary files differdeleted file mode 100644 index 49389198bdf..00000000000 --- a/etc/images/gnus/prev-ur.pbm +++ /dev/null diff --git a/etc/images/gnus/prev-ur.xpm b/etc/images/gnus/prev-ur.xpm deleted file mode 100644 index 80131332832..00000000000 --- a/etc/images/gnus/prev-ur.xpm +++ /dev/null @@ -1,35 +0,0 @@ -/* XPM */ -static char * prev_ur_xpm[] = { -"24 24 8 1", -". c None", -" c #000000000000", -"X c #A5A5A5A59595", -"o c #C7C7C6C6C6C6", -"O c #FFFF00000000", -"+ c #9A9A6C6C4E4E", -"@ c #E1E1E0E0E0E0", -"# c #FFFFFFFFFFFF", -" .. .. .. .. .. .. .. ..", -"........................", -"............X...........", -" .. .. .. .XXX. .. .. ..", -".........XXooOX.........", -".......XXooo+O@X........", -" .. XXXoooo++@@@X. .. ..", -"....X@Xoooooo@@@X.......", -"....X@@Xooo@@@@@@X......", -" .. X@@XXoo@@@@@@@X.. ..", -"....X@@Xo @@@@@@ X....", -"....X@Xo ## X @ ## X...", -" .. oXo #XXXoO@ #### ..", -"....oXoXXooo+OX #### ...", -"....XXXoooo++@@X ## ....", -" .. X@Xoooooo@@@X .. ..", -"....X@@Xooo@@@@@@X......", -"....X@@XXoo@@@@@@@X.....", -" .. X@@Xoo@@@@@@@@@X. ..", -"....X@Xo@@@@@@@@@@@@X...", -"... oXoo@@@@@@@@@@@@X...", -" .. oXo@@@@@@@@@@@@X....", -".....oX@@@@@@@@@@@X.....", -".....oX@@@@@@@@@@X......"}; diff --git a/etc/images/gnus/receipt.pbm b/etc/images/gnus/receipt.pbm deleted file mode 100644 index 5595239f40d..00000000000 --- a/etc/images/gnus/receipt.pbm +++ /dev/null @@ -1,3 +0,0 @@ -P4 -24 24 -ÿÿÿÿÿÿÿÿçÿÿ÷ÿÿûÿÿûÿÿçÿÿŸÿþÿÿÇÿÿ¿ÿÿÿøÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿÿ
\ No newline at end of file diff --git a/etc/images/gnus/receipt.xpm b/etc/images/gnus/receipt.xpm deleted file mode 100644 index 18caaf1cf78..00000000000 --- a/etc/images/gnus/receipt.xpm +++ /dev/null @@ -1,32 +0,0 @@ -/* XPM */ -static char * receipt_xpm[] = { -"24 24 5 1", -" c None", -". c #FFFFFFFFFFFF", -"X c #676766666363", -"o c #FFFF00000000", -"O c #AEAE3E3E4848", -" ", -" ", -" .. ", -" . ", -" . ", -" . ", -" .. ", -" Xooo .. ", -" Xoooooooo.. ", -" Xoooooooooooooo ... ", -" oooooooooooOOoo . ", -" ooooooooooOOOOo. ", -" oooooooooOO...o ", -" ooooooooooOOooo ", -" ooooooooooooooo ", -" ooooooooooooooo ", -" oooooooooooooo ", -" ooooooooooo ", -" ooooooo ", -" oooo ", -" oo ", -" ", -" ", -" "}; diff --git a/etc/images/gnus/reply-wo.pbm b/etc/images/gnus/reply-wo.pbm Binary files differdeleted file mode 100644 index def54da8ede..00000000000 --- a/etc/images/gnus/reply-wo.pbm +++ /dev/null diff --git a/etc/images/gnus/reply-wo.xpm b/etc/images/gnus/reply-wo.xpm deleted file mode 100644 index 370678af70d..00000000000 --- a/etc/images/gnus/reply-wo.xpm +++ /dev/null @@ -1,31 +0,0 @@ -/* XPM */ -static char * reply_wo_xpm[] = { -"24 24 4 1", -" c None", -". c #000000000000", -"X c #E1E1E0E0E0E0", -"O c #FFFFFFFFFFFF", -" ", -" ", -" ", -" .... ", -" ..X.... ", -" ..XX.XX.. ", -" .O.XX.XXXX.. ", -" ..O.XXX.XXXX... ", -" .OO.XXXX.X....... ", -" .OO.XXXX...XXX.OO.. ", -" ..OO.XX....XXXX.OOOO.. ", -" .......XX.XXXX.OOO.... ", -" .OOO.XXX.XXXX.OO..OOO. ", -" .OOOO....XXX....OOOOO. ", -" .OOOOOOO..XX..OOOOOOO. ", -" .OOOOOOO......OOOOOOO. ", -" .OOOOOO.OO..O..OOOOOO. ", -" .OOOOO.OOOOOOOO.OOOOO. ", -" .OOOO.OOOOOOOOOO.OOOO. ", -" .OOO.OOOOOOOOOOOO.OOO. ", -" .O..OOOOOOOOOOOOOO..O. ", -" ..OOOOOOOOOOOOOOOOOO.. ", -" ...................... ", -" "}; diff --git a/etc/images/gnus/reply.pbm b/etc/images/gnus/reply.pbm Binary files differdeleted file mode 100644 index ee181e663be..00000000000 --- a/etc/images/gnus/reply.pbm +++ /dev/null diff --git a/etc/images/gnus/reply.xpm b/etc/images/gnus/reply.xpm deleted file mode 100644 index a45884803fe..00000000000 --- a/etc/images/gnus/reply.xpm +++ /dev/null @@ -1,31 +0,0 @@ -/* XPM */ -static char * reply_xpm[] = { -"24 24 4 1", -" c None", -". c #000000000000", -"X c #E1E1E0E0E0E0", -"O c #FFFFFFFFFFFF", -" ", -" ", -" ", -" .... ", -" ..XXX.. ", -" ..XXXXX.. ", -" .O.XXXXXXX.. ", -" ..O.XXXXXXXXX.. ", -" .OO.XXXXXXXXXX... ", -" .OO.XXXXXXXXXX.OO.. ", -" ..OO.XXXXXXXXXX.OOOO.. ", -" .....XXXXXXXXX.OOO.... ", -" .OOO.XXXXXXXX.OO..OOO. ", -" .OOOO...XXXXX...OOOOO. ", -" .OOOOOOO..XX..OOOOOOO. ", -" .OOOOOOO......OOOOOOO. ", -" .OOOOOO.OO..O..OOOOOO. ", -" .OOOOO.OOOOOOOO.OOOOO. ", -" .OOOO.OOOOOOOOOO.OOOO. ", -" .OOO.OOOOOOOOOOOO.OOO. ", -" .O..OOOOOOOOOOOOOO..O. ", -" ..OOOOOOOOOOOOOOOOOO.. ", -" ...................... ", -" "}; diff --git a/etc/images/gnus/rot13.pbm b/etc/images/gnus/rot13.pbm Binary files differdeleted file mode 100644 index 800d9d6327b..00000000000 --- a/etc/images/gnus/rot13.pbm +++ /dev/null diff --git a/etc/images/gnus/rot13.xpm b/etc/images/gnus/rot13.xpm deleted file mode 100644 index 18faa3e92da..00000000000 --- a/etc/images/gnus/rot13.xpm +++ /dev/null @@ -1,128 +0,0 @@ -/* XPM */ -static char * rot13_xpm[] = { -"24 24 101 2", -" g None", -". g #000000", -"+ g #212121", -"@ g #9E9E9E", -"# g #E6E6E6", -"$ g #E7E7E7", -"% g #C8C8C8", -"& g #A0A0A0", -"* g #131313", -"= g #5F5F5F", -"- g #EDEDED", -"; g #D6D6D6", -"> g #D5D5D5", -", g #DDDDDD", -"' g #D8D8D8", -") g #A1A1A1", -"! g #3C3C3C", -"~ g #353535", -"{ g #EFEFEF", -"] g #CFCFCF", -"^ g #4C4C4C", -"/ g #141414", -"( g #6A6A6A", -"_ g #D0D0D0", -": g #B2B2B2", -"< g #454545", -"[ g #E2E2E2", -"} g #292929", -"| g #0F0F0F", -"1 g #949494", -"2 g #E9E9E9", -"3 g #C3C3C3", -"4 g #1C1C1C", -"5 g #E1E1E1", -"6 g #272727", -"7 g #DEDEDE", -"8 g #B6B6B6", -"9 g #0C0C0C", -"0 g #262626", -"a g #1F1F1F", -"b g #616161", -"c g #5B5B5B", -"d g #232323", -"e g #111111", -"f g #181818", -"g g #3D3D3D", -"h g #636363", -"i g #545454", -"j g #2E2E2E", -"k g #242424", -"l g #070707", -"m g #DCDCDC", -"n g #D3D3D3", -"o g #C5C5C5", -"p g #C2C2C2", -"q g #BFBFBF", -"r g #B5B5B5", -"s g #696969", -"t g #ACACAC", -"u g #999999", -"v g #8F8F8F", -"w g #868686", -"x g #686868", -"y g #B1B1B1", -"z g #9A9A9A", -"A g #909090", -"B g #878787", -"C g #DBDBDB", -"D g #A6A6A6", -"E g #979797", -"F g #8A8A8A", -"G g #8D8D8D", -"H g #838383", -"I g #666666", -"J g #BBBBBB", -"K g #9F9F9F", -"L g #8B8B8B", -"M g #828282", -"N g #676767", -"O g #A3A3A3", -"P g #8E8E8E", -"Q g #888888", -"R g #8C8C8C", -"S g #BABABA", -"T g #818181", -"U g #757575", -"V g #DADADA", -"W g #AFAFAF", -"X g #848484", -"Y g #7F7F7F", -"Z g #7B7B7B", -"` g #B8B8B8", -" . g #D9D9D9", -".. g #ABABAB", -"+. g #929292", -"@. g #939393", -"#. g #808080", -"$. g #919191", -"%. g #ADADAD", -"&. g #969696", -"*. g #4A4A4A", -" ", -" ", -" . . . . . ", -" . + @ # $ % & * ", -" . = - # ; > , ' ) ! . ", -" ~ { ] ^ . . / ( _ : < ", -" . [ ' } . | ( % 1 . ", -" * 2 3 . 4 5 @ . ", -" 6 7 8 . . $ 8 . ", -" 9 0 a b c d e 6 a f a g h i j k l ", -" . 7 m ' ; n o p p p p q r r r s . ", -" . 7 p 8 : t t t t t t t u v w x . ", -" . m p 8 y t t t t t t t z A B s . ", -" . C p r D E E E E E E A F G H I . ", -" . , p 8 J t t t t t t t K L M N . ", -" . m p y O E E E E E E P Q R H ( . ", -" . m p r S t t t t t t t K L T U . ", -" . V p W & E E E E E E F X B Y Z . ", -" . C p y ` t t t t t t t K F B T . ", -" . .p W ..E E E E E E E +.G @.#.. ", -" . $.%.z &.A L F F G $.A A P X *.. ", -" . . . . . . . . . . . . . . . ", -" ", -" "}; diff --git a/etc/images/gnus/save-aif.pbm b/etc/images/gnus/save-aif.pbm Binary files differdeleted file mode 100644 index 15829c289e7..00000000000 --- a/etc/images/gnus/save-aif.pbm +++ /dev/null diff --git a/etc/images/gnus/save-aif.xpm b/etc/images/gnus/save-aif.xpm deleted file mode 100644 index f0325ac2fb9..00000000000 --- a/etc/images/gnus/save-aif.xpm +++ /dev/null @@ -1,33 +0,0 @@ -/* XPM */ -static char * save_aif_xpm[] = { -"24 24 6 1", -" c None", -". c #999999999999", -"X c #E1E1E0E0E0E0", -"o c #C7C7C6C6C6C6", -"O c #000000000000", -"+ c #FFFFFFFFFFFF", -" ", -" ", -" ............. ", -" .XXXXXXXXXX.X.. ", -" .XXXXXXXXXX.XX. ", -" .XXXXXXXXXX.... ", -" .XXXXXXXXXXooo. ", -" .XXXXXXXXXXXXX. ", -" .XXXXXXXXXXXXX. ", -" .XXXXXXXXXXXXX. ", -" OOOOOOOOOOOOOOXXXXXX. ", -" O..O+++++++O.OXXXXXX. ", -" O..O+++++++O.OXXXXXX. ", -" O..O+++++++O.OXXXXXX. ", -" O..O+++++++O.OXXXXXX. ", -" O..O+++++++O.OXXXXXX. ", -" O..OOOOOOOOO.OXXXXXX. ", -" O............OXXXXXX. ", -" O............OXXXXXX. ", -" O..OOOOOOOOO.O....... ", -" O..OoooooO++.O ", -" O..OoooooO++.O ", -" O.OoooooO++.O ", -" OOOOOOOOOOOO "}; diff --git a/etc/images/gnus/save-art.pbm b/etc/images/gnus/save-art.pbm Binary files differdeleted file mode 100644 index 68fe0cb3098..00000000000 --- a/etc/images/gnus/save-art.pbm +++ /dev/null diff --git a/etc/images/gnus/save-art.xpm b/etc/images/gnus/save-art.xpm deleted file mode 100644 index fe9726fa3fe..00000000000 --- a/etc/images/gnus/save-art.xpm +++ /dev/null @@ -1,32 +0,0 @@ -/* XPM */ -static char * save_art_xpm[] = { -"24 24 5 1", -" c None", -". c #000000000000", -"X c #FFFFFFFFFFFF", -"o c #999999999999", -"O c #C7C7C6C6C6C6", -" ", -" ", -" .................. ", -" ...XXXXXXXXXXXXX.. ", -" .XX..XXXXXXXXX..X. ", -" .XXXX..XXXXX..XXX. ", -" .XXXXX......XXXXX. ", -" .XXX..XX..XX..XXX. ", -" .XX..XXXXXXXX..XX. ", -" ...XXXXXXXXXXXX... ", -" ..............XXXXXXX. ", -" .oo.XXXXXXX.o......... ", -" .oo.XXXXXXX.o. ", -" .oo.XXXXXXX.o. ", -" .oo.XXXXXXX.o. ", -" .oo.XXXXXXX.o. ", -" .oo.........o. ", -" .oooooooooooo. ", -" .oooooooooooo. ", -" .oo.........o. ", -" .oo.OOOOO.XXo. ", -" .oo.OOOOO.XXo. ", -" .o.OOOOO.XXo. ", -" ............ "}; diff --git a/etc/images/gnus/subscribe.pbm b/etc/images/gnus/subscribe.pbm Binary files differdeleted file mode 100644 index fe6b3920d36..00000000000 --- a/etc/images/gnus/subscribe.pbm +++ /dev/null diff --git a/etc/images/gnus/subscribe.xpm b/etc/images/gnus/subscribe.xpm deleted file mode 100644 index ff193a9e8ab..00000000000 --- a/etc/images/gnus/subscribe.xpm +++ /dev/null @@ -1,32 +0,0 @@ -/* XPM */ -static char * subscribe_xpm[] = { -"24 24 5 1", -" c None", -". c #A5A5A5A59595", -"X c #E1E1E0E0E0E0", -"o c #C7C7C6C6C6C6", -"O c #8686ADAD7D7D", -" ", -" ", -" ", -" ... ", -" ..XXX..... ", -"...XXXXX..XXX. ... ", -".X.XX...XXXX...XXX. ", -".XX.X.X.XX...XXXXX. ", -".XX...XX.X.X.XXXXXX. ", -".XX.o.XX...XX.XXXXXX. ", -".X.oo.XX.o.XX..XXXXXX. ", -"o.ooo.X.oo.XX.XXXOXXX. ", -"o.oXXo.ooo.X.oXXOXXXXX. ", -" o.XXo.oXXo.ooXXOXXXXX. ", -" o.XXXo.XXo.oXXXOXXXXXX.", -" o.XXo.XXXo.XOOOOXXXXX.", -" o.XXoo.XXo.XXXOOXXXXX.", -" o.XXo.XXXo.XXXXXXX...", -" o.XX.o.XXo.XXXXXX.oo ", -" o..oo.XX.o.XXX..o ", -" oo o..oo.XX.oo ", -" oo o..o ", -" oo ", -" "}; diff --git a/etc/images/gnus/unimportant.pbm b/etc/images/gnus/unimportant.pbm Binary files differdeleted file mode 100644 index 26a87216247..00000000000 --- a/etc/images/gnus/unimportant.pbm +++ /dev/null diff --git a/etc/images/gnus/unimportant.xpm b/etc/images/gnus/unimportant.xpm deleted file mode 100644 index 4298224e56c..00000000000 --- a/etc/images/gnus/unimportant.xpm +++ /dev/null @@ -1,32 +0,0 @@ -/* XPM */ -static char *magick[] = { -/* columns rows colors chars-per-pixel */ -"24 24 2 1", -"! c blue", -"w c Gray75", -/* pixels */ -"wwwwwwwwwwwwwwwwwwwwwwww", -"wwwwwwwwwwwwwwwwwwwwwwww", -"wwwwwwwwwww!!!wwwwwwwwww", -"wwwwwwwwwww!!!wwwwwwwwww", -"wwwwwwwwwww!!!wwwwwwwwww", -"wwwwwwwwwww!!!wwwwwwwwww", -"wwwwwwwwwww!!!wwwwwwwwww", -"wwwwwwwwwww!!!wwwwwwwwww", -"wwwwwwwwwww!!!wwwwwwwwww", -"wwwwwwwwwww!!!wwwwwwwwww", -"wwwwwwwwwww!!!wwwwwwwwww", -"wwwwwwwwwww!!!wwwwwwwwww", -"ww!!!wwwwww!!!wwwwww!!!w", -"www!!!wwwww!!!wwwww!!!ww", -"wwww!!!wwww!!!wwww!!!www", -"wwwww!!!www!!!www!!!wwww", -"wwwwww!!!ww!!!ww!!!wwwww", -"wwwwwww!!!w!!!w!!!wwwwww", -"wwwwwwww!!!!!!!!!wwwwwww", -"wwwwwwwww!!!!!!!wwwwwwww", -"wwwwwwwwww!!!!!wwwwwwwww", -"wwwwwwwwwww!!!wwwwwwwwww", -"wwwwwwwwwwwwwwwwwwwwwwww", -"wwwwwwwwwwwwwwwwwwwwwwww" -}; diff --git a/etc/images/gnus/unsubscribe.pbm b/etc/images/gnus/unsubscribe.pbm Binary files differdeleted file mode 100644 index 7d869fb53fe..00000000000 --- a/etc/images/gnus/unsubscribe.pbm +++ /dev/null diff --git a/etc/images/gnus/unsubscribe.xpm b/etc/images/gnus/unsubscribe.xpm deleted file mode 100644 index a91180d00f8..00000000000 --- a/etc/images/gnus/unsubscribe.xpm +++ /dev/null @@ -1,32 +0,0 @@ -/* XPM */ -static char * unsubscribe_xpm[] = { -"24 24 5 1", -" c None", -". c #A5A5A5A59595", -"X c #E1E1E0E0E0E0", -"o c #C7C7C6C6C6C6", -"O c #FFFF00000000", -" ", -" ", -" ", -" ... ", -" ..XXX..... ", -"...XXXXX..XXX. ... ", -".X.XX...XXXX...XXX. ", -".XX.X.X.XX...XXXXX. ", -".XX...XX.X.X.XXXXXX. ", -".XX.o.XX...XX.XXXXXX. ", -".X.oo.XX.o.XX..XXXXXX. ", -"o.ooo.X.oo.XX.XXXXXXX. ", -"o.oXXo.ooo.X.oXXXXXXXX. ", -" o.XXo.oXXo.ooXXOXXXXX. ", -" o.XXXo.XXo.oXXXOXXXXXX.", -" o.XXo.XXXo.XOOOXXXXXX.", -" o.XXoo.XXo.XoOOOXXXXX.", -" o.XXo.XXXo.XOoOXXX...", -" o.XX.o.XXo.XOXoXX.oo ", -" o..oo.XX.o.oXX..o ", -" oo o..oo.XX.oo ", -" oo o..o ", -" oo ", -" "}; diff --git a/etc/images/gnus/uu-decode.pbm b/etc/images/gnus/uu-decode.pbm Binary files differdeleted file mode 100644 index 2b7fada1473..00000000000 --- a/etc/images/gnus/uu-decode.pbm +++ /dev/null diff --git a/etc/images/gnus/uu-decode.xpm b/etc/images/gnus/uu-decode.xpm deleted file mode 100644 index b9d940cc99e..00000000000 --- a/etc/images/gnus/uu-decode.xpm +++ /dev/null @@ -1,36 +0,0 @@ -/* XPM */ -static char * uu_decode_xpm[] = { -"24 24 9 1", -" c None", -". c #919187876969", -"X c #C2C2B9B99C9C", -"o c #868686868686", -"O c #8F8F8F8F8F8F", -"+ c #000000000000", -"@ c #4C4C4C4C4C4C", -"# c #E9E9EFEFE8E8", -"$ c #8686ADAD7D7D", -" ", -" ", -" ", -" .............. ", -" X.o.........O.++ ", -" XX++++++++++..++ ", -" XX@########+..++ ", -" XX@########+..++ ", -" XX@$#$$$#$#+..++ ", -" XX@#$$$$$$#+..++ ", -" XX@##$#####+..++ ", -" XX@##$#$$##+..++ ", -" XX@##$#$$##+..++ ", -" XX@##$$#$$#+..++ ", -" XX@######$#+..++ ", -" XX@########+..++ ", -" XX@########+..++ ", -" XX.@@@@@@@@@..++ ", -" X.XXXXXXXXXX..++ ", -" .XXXXXXXXXXXX.++ ", -" +++++++++++++++ ", -" +++++++++++++++ ", -" ", -" "}; diff --git a/etc/images/gnus/uu-post.pbm b/etc/images/gnus/uu-post.pbm Binary files differdeleted file mode 100644 index a5face70980..00000000000 --- a/etc/images/gnus/uu-post.pbm +++ /dev/null diff --git a/etc/images/gnus/uu-post.xpm b/etc/images/gnus/uu-post.xpm deleted file mode 100644 index 7c4204c6957..00000000000 --- a/etc/images/gnus/uu-post.xpm +++ /dev/null @@ -1,35 +0,0 @@ -/* XPM */ -static char * uu_post_xpm[] = { -"24 24 8 1", -". c None", -"X c #000000000000", -"+ c #C2C2B9B99C9C", -"@ c #919187876969", -"# c #868686868686", -"% c #4C4C4C4C4C4C", -"& c #E9E9EFEFE8E8", -"* c #8686ADAD7D7D", -"X..X..X..X.XX..X..X..X..", -"..........X.X...........", -".........X...X..........", -"X..X..X.XX..X.XX..X..X..", -".......X.......X........", -"......X.........X.......", -"X..X+X@@@@@@@@@@@XX..X..", -"....+@@@@@@@@@@@@@......", -"....++XXXXXXXXXX@@......", -"X..X++%&&&&&&&&X@@X..X..", -"....++%&&&&&&&&X@@......", -"....++%*&***&*&X@@......", -"X..X++%&******&X@@X..X..", -"....++%&&*&&&&&X@@......", -"....++%&&*&**&&X@@......", -"X..X++%&&*&**&&X@@X..X..", -"....++%&&**&**&X@@......", -"....++%&&&&&&*&X@@......", -"X..X++%&&&&&&&&X@@X..X..", -"....++%&&&&&&&&X@@......", -"....++@%%%%%%%%%@@......", -"X..X+@++++++++++@@X..X..", -"....+++++++++++++@......", -"........................"}; diff --git a/etc/publicsuffix.txt b/etc/publicsuffix.txt index 3cf06f92bbf..220ad30e484 100644 --- a/etc/publicsuffix.txt +++ b/etc/publicsuffix.txt @@ -22,8 +22,7 @@ org.ac ad nom.ad -// ae : https://en.wikipedia.org/wiki/.ae -// see also: "Domain Name Eligibility Policy" at http://www.aeda.ae/eng/aepolicy.php +// ae : https://tdra.gov.ae/en/aeda/ae-policies ae co.ae net.ae @@ -7131,7 +7130,7 @@ org.zw // newGTLDs -// List of new gTLDs imported from https://www.icann.org/resources/registries/gtlds/v2/gtlds.json on 2022-02-18T15:13:38Z +// List of new gTLDs imported from https://www.icann.org/resources/registries/gtlds/v2/gtlds.json on 2022-04-30T15:14:46Z // This list is auto-generated, don't edit it manually. // aaa : 2015-02-26 American Automobile Association, Inc. aaa @@ -7334,7 +7333,7 @@ audi // audible : 2015-06-25 Amazon Registry Services, Inc. audible -// audio : 2014-03-20 UNR Corp. +// audio : 2014-03-20 XYZ.COM LLC audio // auspost : 2015-08-13 Australian Postal Corporation @@ -7472,7 +7471,7 @@ bio // black : 2014-01-16 Afilias Limited black -// blackfriday : 2014-01-16 UNR Corp. +// blackfriday : 2014-01-16 Registry Services, LLC blackfriday // blockbuster : 2015-07-30 Dish DBS Corporation @@ -7703,7 +7702,7 @@ cheap // chintai : 2015-06-11 CHINTAI Corporation chintai -// christmas : 2013-11-21 UNR Corp. +// christmas : 2013-11-21 XYZ.COM LLC christmas // chrome : 2014-07-24 Charleston Road Registry Inc. @@ -7952,7 +7951,7 @@ dhl // diamonds : 2013-09-22 Binky Moon, LLC diamonds -// diet : 2014-06-26 UNR Corp. +// diet : 2014-06-26 XYZ.COM LLC diet // digital : 2014-03-06 Binky Moon, LLC @@ -8198,7 +8197,7 @@ flir // florist : 2013-11-07 Binky Moon, LLC florist -// flowers : 2014-10-09 UNR Corp. +// flowers : 2014-10-09 XYZ.COM LLC flowers // fly : 2014-05-08 Charleston Road Registry Inc. @@ -8285,7 +8284,7 @@ gallo // gallup : 2015-02-19 Gallup, Inc. gallup -// game : 2015-05-28 UNR Corp. +// game : 2015-05-28 XYZ.COM LLC game // games : 2015-05-28 Dog Beach, LLC @@ -8309,7 +8308,7 @@ gdn // gea : 2014-12-04 GEA Group Aktiengesellschaft gea -// gent : 2014-01-23 COMBELL NV +// gent : 2014-01-23 Easyhost BV gent // genting : 2015-03-12 Resorts World Inc Pte. Ltd. @@ -8420,7 +8419,7 @@ guge // guide : 2013-09-13 Binky Moon, LLC guide -// guitars : 2013-11-14 UNR Corp. +// guitars : 2013-11-14 XYZ.COM LLC guitars // guru : 2013-08-27 Binky Moon, LLC @@ -8468,7 +8467,7 @@ hermes // hgtv : 2015-07-02 Lifestyle Domain Holdings, Inc. hgtv -// hiphop : 2014-03-06 UNR Corp. +// hiphop : 2014-03-06 Dot Hip Hop, LLC hiphop // hisamitsu : 2015-07-16 Hisamitsu Pharmaceutical Co.,Inc. @@ -8516,7 +8515,7 @@ hospital // host : 2014-04-17 Radix FZC host -// hosting : 2014-05-29 UNR Corp. +// hosting : 2014-05-29 XYZ.COM LLC hosting // hot : 2015-08-27 Amazon Registry Services, Inc. @@ -8885,7 +8884,7 @@ locus // loft : 2015-07-30 Annco, Inc. loft -// lol : 2015-01-30 UNR Corp. +// lol : 2015-01-30 XYZ.COM LLC lol // london : 2013-11-14 Dot London Domains Limited @@ -9041,7 +9040,7 @@ moe // moi : 2014-12-18 Amazon Registry Services, Inc. moi -// mom : 2015-04-16 UNR Corp. +// mom : 2015-04-16 XYZ.COM LLC mom // monash : 2013-09-30 Monash University @@ -9308,7 +9307,7 @@ philips // phone : 2016-06-02 Dish DBS Corporation phone -// photo : 2013-11-14 UNR Corp. +// photo : 2013-11-14 Registry Services, LLC photo // photography : 2013-09-20 Binky Moon, LLC @@ -9320,7 +9319,7 @@ photos // physio : 2014-05-01 PhysBiz Pty Ltd physio -// pics : 2013-11-14 UNR Corp. +// pics : 2013-11-14 XYZ.COM LLC pics // pictet : 2014-06-26 Pictet Europe S.A. @@ -9551,7 +9550,7 @@ rsvp // rugby : 2016-12-15 World Rugby Strategic Developments Limited rugby -// ruhr : 2013-10-02 regiodot GmbH & Co. KG +// ruhr : 2013-10-02 dotSaarland GmbH ruhr // run : 2015-03-19 Binky Moon, LLC @@ -9902,7 +9901,7 @@ tatamotors // tatar : 2014-04-24 Limited Liability Company "Coordination Center of Regional Domain of Tatarstan Republic" tatar -// tattoo : 2013-08-30 UNR Corp. +// tattoo : 2013-08-30 Top Level Design, LLC tattoo // tax : 2014-03-20 Binky Moon, LLC @@ -9995,7 +9994,7 @@ toray // toshiba : 2014-04-10 TOSHIBA Corporation toshiba -// total : 2015-08-06 Total SA +// total : 2015-08-06 TOTAL SE total // tours : 2015-01-22 Binky Moon, LLC @@ -10633,6 +10632,12 @@ hlx3.page // Submitted by Przemyslaw Plewa <it-admin@domena.pl> beep.pl +// Airkit : https://www.airkit.com/ +// Submitted by Grant Cooksey <security@airkit.com> +airkitapps.com +airkitapps-au.com +airkitapps.eu + // Aiven: https://aiven.io/ // Submitted by Etienne Stalmans <security@aiven.io> aivencloud.com @@ -10827,7 +10832,7 @@ onavstack.net *.advisor.ws // AZ.pl sp. z.o.o: https://az.pl -// Submited by Krzysztof Wolski <krzysztof.wolski@home.eu> +// Submitted by Krzysztof Wolski <krzysztof.wolski@home.eu> ecommerce-shop.pl // b-data GmbH : https://www.b-data.io @@ -11241,6 +11246,11 @@ deno-staging.dev // Submitted by Peter Thomassen <peter@desec.io> dedyn.io +// Deta: https://www.deta.sh/ +// Submitted by Aavash Shrestha <aavash@deta.sh> +deta.app +deta.dev + // Diher Solutions : https://diher.solutions // Submitted by Didi Hermawan <mail@diher.solutions> *.rss.my.id @@ -11658,6 +11668,11 @@ en-root.fr mytuleap.com tuleap-partners.com +// Encoretivity AB: https://encore.dev +// Submitted by André Eriksson <andre@encore.dev> +encr.app +encoreapi.com + // ECG Robotics, Inc: https://ecgrobotics.org // Submitted by <frc1533@ecgrobotics.org> onred.one @@ -11870,8 +11885,6 @@ app.os.stg.fedoraproject.org // FearWorks Media Ltd. : https://fearworksmedia.co.uk // submitted by Keith Fairley <domains@fearworksmedia.co.uk> -couk.me -ukco.me conn.uk copro.uk hosp.uk @@ -11984,6 +11997,7 @@ independent-panel.uk independent-review.uk public-inquiry.uk royal-commission.uk +campaign.gov.uk service.gov.uk // CDDO : https://www.gov.uk/guidance/get-an-api-domain-on-govuk @@ -12277,7 +12291,7 @@ günstigbestellen.de günstigliefern.de // Hakaran group: http://hakaran.cz -// Submited by Arseniy Sokolov <security@hakaran.cz> +// Submitted by Arseniy Sokolov <security@hakaran.cz> fin.ci free.hr caa.li @@ -12320,7 +12334,7 @@ development.run ravendb.run // home.pl S.A.: https://home.pl -// Submited by Krzysztof Wolski <krzysztof.wolski@home.eu> +// Submitted by Krzysztof Wolski <krzysztof.wolski@home.eu> homesklep.pl // Hong Kong Productivity Council: https://www.hkpc.org/ @@ -12430,7 +12444,7 @@ to.leg.br pixolino.com // Internet-Pro, LLP: https://netangels.ru/ -// Submited by Vasiliy Sheredeko <piphon@gmail.com> +// Submitted by Vasiliy Sheredeko <piphon@gmail.com> na4u.ru // iopsys software solutions AB : https://iopsys.eu/ @@ -12453,7 +12467,7 @@ iserv.dev iobb.net // Jelastic, Inc. : https://jelastic.com/ -// Submited by Ihor Kolodyuk <ik@jelastic.com> +// Submitted by Ihor Kolodyuk <ik@jelastic.com> mel.cloudlets.com.au cloud.interhostsolutions.be users.scale.virtualcloud.com.br @@ -12653,6 +12667,10 @@ ip.linodeusercontent.com // Submitted by Victor Velchev <admin@liquidnetlimited.com> we.bs +// Localcert : https://localcert.dev +// Submitted by Lann Martin <security@localcert.dev> +*.user.localcert.dev + // localzone.xyz // Submitted by Kenny Niehage <hello@yahe.sh> localzone.xyz @@ -12780,12 +12798,13 @@ eu.meteorapp.com co.pl // Microsoft Corporation : http://microsoft.com -// Submitted by Mitch Webster <miwebst@microsoft.com> +// Submitted by Public Suffix List Admin <msftpsladmin@microsoft.com> *.azurecontainer.io azurewebsites.net azure-mobile.net cloudapp.net azurestaticapps.net +1.azurestaticapps.net centralus.azurestaticapps.net eastasia.azurestaticapps.net eastus2.azurestaticapps.net @@ -13080,7 +13099,7 @@ operaunite.com tech.orange // Oursky Limited : https://authgear.com/, https://skygear.io/ -// Submited by Authgear Team <hello@authgear.com>, Skygear Developer <hello@skygear.io> +// Submitted by Authgear Team <hello@authgear.com>, Skygear Developer <hello@skygear.io> authgear-staging.com authgearapps.com skygearapp.com @@ -13379,6 +13398,34 @@ sandcats.io logoip.de logoip.com +// Scaleway : https://www.scaleway.com/ +// Submitted by Rémy Léone <rleone@scaleway.com> +fr-par-1.baremetal.scw.cloud +fr-par-2.baremetal.scw.cloud +nl-ams-1.baremetal.scw.cloud +fnc.fr-par.scw.cloud +functions.fnc.fr-par.scw.cloud +k8s.fr-par.scw.cloud +nodes.k8s.fr-par.scw.cloud +s3.fr-par.scw.cloud +s3-website.fr-par.scw.cloud +whm.fr-par.scw.cloud +priv.instances.scw.cloud +pub.instances.scw.cloud +k8s.scw.cloud +k8s.nl-ams.scw.cloud +nodes.k8s.nl-ams.scw.cloud +s3.nl-ams.scw.cloud +s3-website.nl-ams.scw.cloud +whm.nl-ams.scw.cloud +k8s.pl-waw.scw.cloud +nodes.k8s.pl-waw.scw.cloud +s3.pl-waw.scw.cloud +s3-website.pl-waw.scw.cloud +scalebook.scw.cloud +smartlabeling.scw.cloud +dedibox.fr + // schokokeks.org GbR : https://schokokeks.org/ // Submitted by Hanno Böck <hanno@schokokeks.org> schokokeks.net @@ -13499,6 +13546,8 @@ srht.site stackhero-network.com // Staclar : https://staclar.com +// Submitted by Q Misell <q@staclar.com> +musician.io // Submitted by Matthias Merkel <matthias.merkel@staclar.com> novecore.site @@ -13597,19 +13646,20 @@ syncloud.it // Synology, Inc. : https://www.synology.com/ // Submitted by Rony Weng <ronyweng@synology.com> -diskstation.me dscloud.biz -dscloud.me -dscloud.mobi +direct.quickconnect.cn dsmynas.com -dsmynas.net -dsmynas.org familyds.com -familyds.net -familyds.org +diskstation.me +dscloud.me i234.me myds.me synology.me +dscloud.mobi +dsmynas.net +familyds.net +dsmynas.org +familyds.org vpnplus.to direct.quickconnect.to @@ -13742,6 +13792,10 @@ syno-ds.de synology-diskstation.de synology-ds.de +// Typedream : https://typedream.com +// Submitted by Putri Karunia <putri@typedream.com> +typedream.app + // Typeform : https://www.typeform.com // Submitted by Sergi Ferriz <sergi.ferriz@typeform.com> pro.typeform.com diff --git a/etc/refcards/Makefile b/etc/refcards/Makefile index 6f8913c5f01..4c5daa9f44c 100644 --- a/etc/refcards/Makefile +++ b/etc/refcards/Makefile @@ -233,10 +233,11 @@ pl-refcard.pdf: $(pl_refcard_deps) fi $(ENVADD) pdftex -output-format=pdf pl-refcard.tex pl-refcard.dvi: $(pl_refcard_deps) - if ! kpsewhich -format=fmt mex > /dev/null; then \ - echo "No mex format found."; false; \ + if kpsewhich -format=fmt mex > /dev/null; then \ + $(ENVADD) tex pl-refcard.tex; \ + else \ + $(ENVADD) mex pl-refcard.tex; \ fi - $(ENVADD) tex pl-refcard.tex pl-refcard.ps: pl-refcard.dvi dvips -t a4 -o $@ pl-refcard.dvi diff --git a/etc/refcards/orgcard.tex b/etc/refcards/orgcard.tex index dec4d174c43..2b4718805a6 100644 --- a/etc/refcards/orgcard.tex +++ b/etc/refcards/orgcard.tex @@ -1,5 +1,5 @@ % Reference Card for Org Mode -\def\orgversionnumber{9.5.2} +\def\orgversionnumber{9.5.3} \def\versionyear{2021} % latest update \input emacsver.tex diff --git a/etc/themes/modus-themes.el b/etc/themes/modus-themes.el index adec113bd21..1c522239508 100644 --- a/etc/themes/modus-themes.el +++ b/etc/themes/modus-themes.el @@ -3368,10 +3368,10 @@ theme's fallback text color." (defun modus-themes--paren (normalbg intensebg) "Conditional use of intense colors for matching parentheses. -NORMALBG should be the special palette color 'bg-paren-match' or +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'." +`bg-paren-match-intense'." (let ((properties (modus-themes--list-or-warn 'modus-themes-paren-match))) (list :inherit (if (memq 'bold properties) @@ -3637,8 +3637,8 @@ clearly distinguishes past, present, future tasks." (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'. +when the `traffic-light' style is applied, while SIMPLE +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 diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c index 7406ef3490e..73c8e45a865 100644 --- a/lib-src/emacsclient.c +++ b/lib-src/emacsclient.c @@ -1431,8 +1431,7 @@ local_sockname (int s, char sockname[socknamesize], int tmpdirlen, char *emacsdirend = sockname + tmpdirlen + suffixlen - strlen(server_name) - 1; *emacsdirend = '\0'; - int dir = openat (AT_FDCWD, sockname, - O_PATH | O_DIRECTORY | O_NOFOLLOW | O_CLOEXEC); + int dir = open (sockname, O_PATH | O_DIRECTORY | O_NOFOLLOW | O_CLOEXEC); *emacsdirend = '/'; if (dir < 0) return errno; diff --git a/lib/mini-gmp.c b/lib/mini-gmp.c index 2b1ddee079b..95f067f82d6 100644 --- a/lib/mini-gmp.c +++ b/lib/mini-gmp.c @@ -90,6 +90,7 @@ see https://www.gnu.org/licenses/. */ #define gmp_assert_nocarry(x) do { \ mp_limb_t __cy = (x); \ assert (__cy == 0); \ + (void) (__cy); \ } while (0) #define gmp_clz(count, x) do { \ diff --git a/lib/string.in.h b/lib/string.in.h index c9432948c15..b6840fa9121 100644 --- a/lib/string.in.h +++ b/lib/string.in.h @@ -125,14 +125,22 @@ _GL_EXTERN_C void rpl_free (void *); # if defined _MSC_VER _GL_EXTERN_C void __cdecl free (void *); # else +# if defined __cplusplus && (__GLIBC__ + (__GLIBC_MINOR__ >= 14) > 2) +_GL_EXTERN_C void free (void *) throw (); +# else _GL_EXTERN_C void free (void *); +# endif # endif # endif #else # if defined _MSC_VER _GL_EXTERN_C void __cdecl free (void *); # else +# if defined __cplusplus && (__GLIBC__ + (__GLIBC_MINOR__ >= 14) > 2) +_GL_EXTERN_C void free (void *) throw (); +# else _GL_EXTERN_C void free (void *); +# endif # endif #endif @@ -230,10 +238,11 @@ _GL_CXXALIAS_SYS_CAST2 (memchr, void const *, (void const *__s, int __c, size_t __n)); # endif # if ((__GLIBC__ == 2 && __GLIBC_MINOR__ >= 10) && !defined __UCLIBC__) \ - && (__GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 4)) -_GL_CXXALIASWARN1 (memchr, void *, (void *__s, int __c, size_t __n)); + && (__GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 4) \ + || defined __clang__) +_GL_CXXALIASWARN1 (memchr, void *, (void *__s, int __c, size_t __n) throw ()); _GL_CXXALIASWARN1 (memchr, void const *, - (void const *__s, int __c, size_t __n)); + (void const *__s, int __c, size_t __n) throw ()); # elif __GLIBC__ >= 2 _GL_CXXALIASWARN (memchr); # endif @@ -315,9 +324,10 @@ _GL_CXXALIAS_SYS_CAST2 (memrchr, void *, (void const *, int, size_t), void const *, (void const *, int, size_t)); # if ((__GLIBC__ == 2 && __GLIBC_MINOR__ >= 10) && !defined __UCLIBC__) \ - && (__GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 4)) -_GL_CXXALIASWARN1 (memrchr, void *, (void *, int, size_t)); -_GL_CXXALIASWARN1 (memrchr, void const *, (void const *, int, size_t)); + && (__GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 4) \ + || defined __clang__) +_GL_CXXALIASWARN1 (memrchr, void *, (void *, int, size_t) throw ()); +_GL_CXXALIASWARN1 (memrchr, void const *, (void const *, int, size_t) throw ()); # else _GL_CXXALIASWARN (memrchr); # endif @@ -345,9 +355,11 @@ _GL_CXXALIAS_SYS_CAST2 (rawmemchr, void *, (void const *__s, int __c_in), void const *, (void const *__s, int __c_in)); # if ((__GLIBC__ == 2 && __GLIBC_MINOR__ >= 10) && !defined __UCLIBC__) \ - && (__GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 4)) -_GL_CXXALIASWARN1 (rawmemchr, void *, (void *__s, int __c_in)); -_GL_CXXALIASWARN1 (rawmemchr, void const *, (void const *__s, int __c_in)); + && (__GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 4) \ + || defined __clang__) +_GL_CXXALIASWARN1 (rawmemchr, void *, (void *__s, int __c_in) throw ()); +_GL_CXXALIASWARN1 (rawmemchr, void const *, + (void const *__s, int __c_in) throw ()); # else _GL_CXXALIASWARN (rawmemchr); # endif @@ -449,9 +461,11 @@ _GL_CXXALIAS_SYS_CAST2 (strchrnul, char const *, (char const *__s, int __c_in)); # endif # if ((__GLIBC__ == 2 && __GLIBC_MINOR__ >= 10) && !defined __UCLIBC__) \ - && (__GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 4)) -_GL_CXXALIASWARN1 (strchrnul, char *, (char *__s, int __c_in)); -_GL_CXXALIASWARN1 (strchrnul, char const *, (char const *__s, int __c_in)); + && (__GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 4) \ + || defined __clang__) +_GL_CXXALIASWARN1 (strchrnul, char *, (char *__s, int __c_in) throw ()); +_GL_CXXALIASWARN1 (strchrnul, char const *, + (char const *__s, int __c_in) throw ()); # else _GL_CXXALIASWARN (strchrnul); # endif @@ -651,10 +665,11 @@ _GL_CXXALIAS_SYS_CAST2 (strpbrk, char *, (char const *__s, char const *__accept), const char *, (char const *__s, char const *__accept)); # if ((__GLIBC__ == 2 && __GLIBC_MINOR__ >= 10) && !defined __UCLIBC__) \ - && (__GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 4)) -_GL_CXXALIASWARN1 (strpbrk, char *, (char *__s, char const *__accept)); + && (__GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 4) \ + || defined __clang__) +_GL_CXXALIASWARN1 (strpbrk, char *, (char *__s, char const *__accept) throw ()); _GL_CXXALIASWARN1 (strpbrk, char const *, - (char const *__s, char const *__accept)); + (char const *__s, char const *__accept) throw ()); # elif __GLIBC__ >= 2 _GL_CXXALIASWARN (strpbrk); # endif @@ -759,10 +774,12 @@ _GL_CXXALIAS_SYS_CAST2 (strstr, const char *, (const char *haystack, const char *needle)); # endif # if ((__GLIBC__ == 2 && __GLIBC_MINOR__ >= 10) && !defined __UCLIBC__) \ - && (__GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 4)) -_GL_CXXALIASWARN1 (strstr, char *, (char *haystack, const char *needle)); + && (__GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 4) \ + || defined __clang__) +_GL_CXXALIASWARN1 (strstr, char *, + (char *haystack, const char *needle) throw ()); _GL_CXXALIASWARN1 (strstr, const char *, - (const char *haystack, const char *needle)); + (const char *haystack, const char *needle) throw ()); # elif __GLIBC__ >= 2 _GL_CXXALIASWARN (strstr); # endif @@ -808,10 +825,12 @@ _GL_CXXALIAS_SYS_CAST2 (strcasestr, const char *, (const char *haystack, const char *needle)); # endif # if ((__GLIBC__ == 2 && __GLIBC_MINOR__ >= 10) && !defined __UCLIBC__) \ - && (__GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 4)) -_GL_CXXALIASWARN1 (strcasestr, char *, (char *haystack, const char *needle)); + && (__GNUC__ > 4 || (__GNUC__ == 4 && __GNUC_MINOR__ >= 4) \ + || defined __clang__) +_GL_CXXALIASWARN1 (strcasestr, char *, + (char *haystack, const char *needle) throw ()); _GL_CXXALIASWARN1 (strcasestr, const char *, - (const char *haystack, const char *needle)); + (const char *haystack, const char *needle) throw ()); # else _GL_CXXALIASWARN (strcasestr); # endif diff --git a/lib/verify.h b/lib/verify.h index 07b2f4866f2..c5c63ae97c6 100644 --- a/lib/verify.h +++ b/lib/verify.h @@ -34,7 +34,7 @@ #ifndef __cplusplus # if (201112L <= __STDC_VERSION__ \ || (!defined __STRICT_ANSI__ \ - && (4 < __GNUC__ + (6 <= __GNUC_MINOR__) || 4 <= __clang_major__))) + && (4 < __GNUC__ + (6 <= __GNUC_MINOR__) || 5 <= __clang_major__))) # define _GL_HAVE__STATIC_ASSERT 1 # endif # if (202000L <= __STDC_VERSION__ \ @@ -215,6 +215,9 @@ template <int w> # define _GL_VERIFY(R, DIAGNOSTIC, ...) \ extern int (*_GL_GENSYM (_gl_verify_function) (void)) \ [_GL_VERIFY_TRUE (R, DIAGNOSTIC)] +# if 4 < __GNUC__ + (6 <= __GNUC_MINOR__) +# pragma GCC diagnostic ignored "-Wnested-externs" +# endif #endif /* _GL_STATIC_ASSERT_H is defined if this code is copied into assert.h. */ diff --git a/lisp/Makefile.in b/lisp/Makefile.in index 308407a8bf1..fabf6ed55e1 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -78,7 +78,9 @@ AUTOGENEL = ${loaddefs} ${srcdir}/cus-load.el ${srcdir}/finder-inf.el \ BYTE_COMPILE_FLAGS = \ --eval '(setq load-prefer-newer t)' $(BYTE_COMPILE_EXTRA_FLAGS) # ... but we must prefer .elc files for those in the early bootstrap. -compile-first: BYTE_COMPILE_FLAGS = $(BYTE_COMPILE_EXTRA_FLAGS) +# A larger `max-specpdl-size' is needed for emacs-lisp/comp.el. +compile-first: BYTE_COMPILE_FLAGS = \ + --eval '(setq max-specpdl-size 5000)' $(BYTE_COMPILE_EXTRA_FLAGS) # Files to compile before others during a bootstrap. This is done to # speed up the bootstrap process. They're ordered by size, so we use diff --git a/lisp/apropos.el b/lisp/apropos.el index a98f2328ac2..79c4df10d25 100644 --- a/lisp/apropos.el +++ b/lisp/apropos.el @@ -663,7 +663,10 @@ search for matches for any two (or more) of those words. With \\[universal-argument] prefix, or if `apropos-do-all' is non-nil, consider all symbols (if they match PATTERN). -Return list of symbols and documentation found." +Return list of symbols and documentation found. + +The *Apropos* window will be selected if `help-window-select' is +non-nil." (interactive (list (apropos-read-pattern "symbol") current-prefix-arg)) (setq apropos--current (list #'apropos pattern do-all)) @@ -1249,7 +1252,9 @@ as a heading." (apropos-print-doc 5 'apropos-widget t) (apropos-print-doc 4 'apropos-plist nil)) (setq-local truncate-partial-width-windows t) - (setq-local truncate-lines t)))) + (setq-local truncate-lines t))) + (when help-window-select + (select-window (get-buffer-window "*Apropos*")))) (prog1 apropos-accumulator (setq apropos-accumulator ()))) ; permit gc diff --git a/lisp/arc-mode.el b/lisp/arc-mode.el index f1a3735d2c6..1c5faa1152b 100644 --- a/lisp/arc-mode.el +++ b/lisp/arc-mode.el @@ -1063,7 +1063,8 @@ NEW-NAME." #'archive--file-desc-ext-file-name (or (archive-get-marked ?*) (list (archive-get-descr)))))) (list names - (read-file-name (format "Copy %s to: " (string-join names ", ")))))) + (read-file-name (format "Copy %s to: " (string-join names ", ")) + nil default-directory)))) (unless (consp files) (setq files (list files))) (when (and (> (length files) 1) diff --git a/lisp/auth-source.el b/lisp/auth-source.el index cd135bd2e2c..fc62e36dfc2 100644 --- a/lisp/auth-source.el +++ b/lisp/auth-source.el @@ -867,7 +867,7 @@ while \(:host t) would find all host entries." secret))) (defun auth-source-pick-first-password (&rest spec) - "Pick the first secret found by applying 'auth-source-search' to SPEC." + "Pick the first secret found by applying `auth-source-search' to SPEC." (auth-info-password (car (apply #'auth-source-search (plist-put spec :max 1))))) (defun auth-source-format-prompt (prompt alist) @@ -1958,7 +1958,7 @@ entries for git.gnus.org: (defun auth-source--decode-octal-string (string) - "Convert octal STRING to utf-8 string. E.g: 'a\134b' to 'a\b'." + "Convert octal STRING to utf-8 string. E.g: \"a\134b\" to \"a\b\"." (let ((list (string-to-list string)) (size (length string))) (decode-coding-string diff --git a/lisp/bindings.el b/lisp/bindings.el index 1913f826004..bfe5ba86237 100644 --- a/lisp/bindings.el +++ b/lisp/bindings.el @@ -1127,6 +1127,7 @@ if `inhibit-field-text-motion' is non-nil." (define-key goto-map "p" 'previous-error) (define-key goto-map "\M-p" 'previous-error) (define-key goto-map "\t" 'move-to-column) +(define-key goto-map "i" 'imenu) (defvar search-map (make-sparse-keymap) "Keymap for search related commands.") diff --git a/lisp/bookmark.el b/lisp/bookmark.el index 31876c83a2f..c604395dd7d 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -1823,8 +1823,34 @@ Don't affect the buffer ring order." ,@(if bookmark-bmenu-toggle-filenames (list location))]) entries))) - (tabulated-list-init-header) - (setq tabulated-list-entries (reverse entries))) + ;; The value of `bookmark-sort-flag' might have changed since the + ;; last time the buffer contents were generated, so re-check it. + (if bookmark-sort-flag + (progn + (setq tabulated-list-sort-key '("Bookmark Name" . nil)) + (setq tabulated-list-entries entries)) + (setq tabulated-list-sort-key nil) + ;; And since we're not sorting by bookmark name, show bookmarks + ;; according to order of creation, with the most recently + ;; created bookmarks at the top and the least recently created + ;; at the bottom. + ;; + ;; Note that clicking the column sort toggle for the bookmark + ;; name column will invoke the `tabulated-list-mode' sort, which + ;; uses `bookmark-bmenu--name-predicate' to sort lexically by + ;; bookmark name instead of by (reverse) creation order. + ;; Clicking the toggle again will reverse the lexical sort, but + ;; the sort will still be lexical not creation-order. However, + ;; if the user reverts the buffer, then the above check of + ;; `bookmark-sort-flag' will happen again and the buffer will + ;; go back to a creation-order sort. This is all expected + ;; behavior, as documented in `bookmark-bmenu-mode'. + (setq tabulated-list-entries (reverse entries))) + ;; Generate the header only after `tabulated-list-sort-key' is + ;; settled, because if that's non-nil then the sort-direction + ;; indicator will be shown in the named column, but if it's + ;; nil then the indicator will not be shown. + (tabulated-list-init-header)) (tabulated-list-print t)) ;;;###autoload @@ -1868,6 +1894,18 @@ deletion, or > if it is flagged for displaying." Each line describes one of the bookmarks in Emacs. Letters do not insert themselves; instead, they are commands. Bookmark names preceded by a \"*\" have annotations. + +If `bookmark-sort-flag' is non-nil, then sort the list by +bookmark name (case-insensitively, in collation order); the +direction of that sort can be reversed by using the column sort +toggle for the bookmark name column. + +If `bookmark-sort-flag' is nil, then sort the list by bookmark +creation order, with most recently created bookmarks on top. +However, the column sort toggle will still activate (and +thereafter toggle the direction of) lexical sorting by bookmark name. +At any time you may use \\[revert-buffer] to go back to sorting by creation order. + \\<bookmark-bmenu-mode-map> \\[bookmark-bmenu-mark] -- mark bookmark to be displayed. \\[bookmark-bmenu-mark-all] -- mark all listed bookmarks to be displayed. @@ -1900,20 +1938,23 @@ Bookmark names preceded by a \"*\" have annotations. in another buffer. \\[bookmark-bmenu-show-all-annotations] -- show the annotations of all bookmarks in another buffer. \\[bookmark-bmenu-edit-annotation] -- edit the annotation for the current bookmark. -\\[bookmark-bmenu-search] -- incrementally search for bookmarks." +\\[bookmark-bmenu-search] -- incrementally search for bookmarks. +\\[revert-buffer] -- refresh the buffer, and thus refresh the sort order (useful + if `bookmark-sort-flag' is nil)." (setq truncate-lines t) (setq buffer-read-only t) ;; FIXME: The header could also display the current default bookmark file ;; according to `bookmark-bookmarks-timestamp'. (setq tabulated-list-format `[("" 1) ;; Space to add "*" for bookmark with annotation - ("Bookmark" ,bookmark-bmenu-file-column bookmark-bmenu--name-predicate) + ("Bookmark Name" + ,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) (when bookmark-sort-flag - (setq tabulated-list-sort-key '("Bookmark" . nil))) + (setq tabulated-list-sort-key '("Bookmark Name" . nil))) (add-hook 'tabulated-list-revert-hook #'bookmark-bmenu--revert nil t)' (setq revert-buffer-function 'bookmark-bmenu--revert) (tabulated-list-init-header)) @@ -1922,17 +1963,19 @@ Bookmark names preceded by a \"*\" have annotations. (defun bookmark-bmenu--name-predicate (a b) "Predicate to sort \"*Bookmark List*\" buffer by the name column. This is used for `tabulated-list-format' in `bookmark-bmenu-mode'." - (string< (caar a) (caar b))) + (string-collate-lessp (caar a) (caar b) nil t)) (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))) + (string-collate-lessp (elt (cadr a) 2) (elt (cadr b) 2) nil t)) (defun bookmark-bmenu--file-predicate (a b) "Predicate to sort \"*Bookmark List*\" buffer by the file column. This is used for `tabulated-list-format' in `bookmark-bmenu-mode'." - (string< (bookmark-location (car a)) (bookmark-location (car b)))) + (string-collate-lessp (bookmark-location (car a)) + (bookmark-location (car b)) + nil t)) (defun bookmark-bmenu-toggle-filenames (&optional show) diff --git a/lisp/button.el b/lisp/button.el index 8a7751d00da..80b73033d68 100644 --- a/lisp/button.el +++ b/lisp/button.el @@ -55,29 +55,24 @@ "Default face used for buttons." :group 'basic-faces) -(defvar button-map - (let ((map (make-sparse-keymap))) - ;; The following definition needs to avoid using escape sequences that - ;; might get converted to ^M when building loaddefs.el - (define-key map [(control ?m)] 'push-button) - (define-key map [mouse-2] 'push-button) - (define-key map [follow-link] 'mouse-face) - ;; FIXME: You'd think that for keymaps coming from text-properties on the - ;; mode-line or header-line, the `mode-line' or `header-line' prefix - ;; shouldn't be necessary! - (define-key map [mode-line mouse-2] 'push-button) - (define-key map [header-line mouse-2] 'push-button) - map) - "Keymap used by buttons.") - -(defvar button-buffer-map - (let ((map (make-sparse-keymap))) - (define-key map [?\t] 'forward-button) - (define-key map "\e\t" 'backward-button) - (define-key map [backtab] 'backward-button) - map) - "Keymap useful for buffers containing buttons. -Mode-specific keymaps may want to use this as their parent keymap.") +(defvar-keymap button-buffer-map + :doc "Keymap useful for buffers containing buttons. +Mode-specific keymaps may want to use this as their parent keymap." + "TAB" #'forward-button + "ESC TAB" #'backward-button + "<backtab>" #'backward-button) + +(defvar-keymap button-map + :doc "Keymap used by buttons." + :parent button-buffer-map + "RET" #'push-button + "<mouse-2>" #'push-button + "<follow-link>" 'mouse-face + ;; FIXME: You'd think that for keymaps coming from text-properties on the + ;; mode-line or header-line, the `mode-line' or `header-line' prefix + ;; shouldn't be necessary! + "<mode-line> <mouse-2>" #'push-button + "<header-line> <mouse-2>" #'push-button) (define-minor-mode button-mode "A minor mode for navigating to buttons with the TAB key." @@ -625,17 +620,34 @@ When clicked, CALLBACK will be called with the DATA as the function argument. If DATA isn't present (or is nil), the button itself will be used instead as the function argument. -If HELP-ECHO, use that as the `help-echo' property." - (propertize string - 'face 'button - 'mouse-face 'highlight - 'help-echo help-echo - 'button t - 'follow-link t - 'category t - 'button-data data - 'keymap button-map - 'action callback)) +If HELP-ECHO, use that as the `help-echo' property. + +Also see `buttonize-region'." + (apply #'propertize string + (button--properties callback data help-echo))) + +(defun button--properties (callback data help-echo) + (list 'face 'button + 'font-lock-face 'button + 'mouse-face 'highlight + 'help-echo help-echo + 'button t + 'follow-link t + 'category t + 'button-data data + 'keymap button-map + 'action callback)) + +(defun buttonize-region (start end callback &optional data help-echo) + "Make the region between START and END into a button. +When clicked, CALLBACK will be called with the DATA as the +function argument. If DATA isn't present (or is nil), the button +itself will be used instead as the function argument. + +If HELP-ECHO, use that as the `help-echo' property. + +Also see `buttonize'." + (add-text-properties start end (button--properties callback data help-echo))) (provide 'button) diff --git a/lisp/calc/calc-yank.el b/lisp/calc/calc-yank.el index 8c6d3f51e5d..172ccf1adcd 100644 --- a/lisp/calc/calc-yank.el +++ b/lisp/calc/calc-yank.el @@ -47,6 +47,8 @@ (calc-check-stack num) (let ((stuff (calc-top-list n (- num n -1)))) (calc-cursor-stack-index num) + (unless calc-kill-line-numbering + (re-search-forward "\\=[0-9]+:\\s-+" (point-at-eol) t)) (let ((first (point))) (calc-cursor-stack-index (- num n)) (if (null nn) diff --git a/lisp/calc/calc.el b/lisp/calc/calc.el index 3b1cf248fd9..b03dcfeb5b7 100644 --- a/lisp/calc/calc.el +++ b/lisp/calc/calc.el @@ -439,6 +439,14 @@ to be identified as that note." :version "24.1" :type 'string) +(defcustom calc-kill-line-numbering t + "If non-nil, calculator kills include any line numbering. + +This option does not affect calc kill and copy commands which +operate on the region, such as `calc-copy-region-as-kill'." + :version "29.1" + :type 'boolean) + (defvar math-format-date-cache) ; calc-forms.el (defface calc-nonselected-face @@ -1375,7 +1383,7 @@ Notations: 3.14e6 3.14 * 10^6 LONG is a desired text for a wide window, SHORT is a desired abbreviated text, and width is the buffer width, which will be -some fraction of the 'parent' window width (At the time of +some fraction of the \"parent\" window width (At the time of writing, 2/3 for calc, 1/3 for trail). The optional FUDGE is a trial-and-error adjustment number for the edge-cases at the border of the two cases." @@ -1816,7 +1824,7 @@ See calc-keypad for details." (if win (progn (calc-cursor-stack-index 0) - (vertical-motion (- 2 (window-height win))) + (vertical-motion (- 3 (window-height win 'floor))) (set-window-start win (point))))) (calc-cursor-stack-index 0) (if (looking-at " *\\.$") diff --git a/lisp/calendar/cal-hebrew.el b/lisp/calendar/cal-hebrew.el index 61ce029e077..1c08de53fbd 100644 --- a/lisp/calendar/cal-hebrew.el +++ b/lisp/calendar/cal-hebrew.el @@ -798,6 +798,10 @@ In this case, the following civil date corresponds to the Hebrew birthday." (diary-ordinal-suffix age) (if (= b-date d) "" " (evening)"))))) +(defvar diary-hebrew-omer-sefirot + ["Hesed" "Gevurah" "Tiferet" "Netzach" "Hod" "Yesod" "Malchut"] + "The order of Sefirot for counting the Omer. +See https://opensiddur.org/prayers/solilunar/solar-cycles/sefirat-haomer/the-order-of-counting-the-omer-in-the-spring/") ;;;###diary-autoload (defun diary-hebrew-omer (&optional mark) "Omer count diary entry. @@ -813,7 +817,7 @@ use when highlighting the day in the calendar." (day (% omer 7))) (if (and (> omer 0) (< omer 50)) (cons mark - (format "Day %d%s of the omer (until sunset)" + (format "Day %d%s of the omer (until sunset) %s she'be'%s" omer (if (zerop week) "" @@ -823,7 +827,10 @@ use when highlighting the day in the calendar." (if (zerop day) "" (format " and %d day%s" - day (if (= day 1) "" "s")))))))))) + day (if (= day 1) "" "s"))))) + (aref diary-hebrew-omer-sefirot (% (+ 6 day) 7)) + (aref diary-hebrew-omer-sefirot + (+ (if (zerop day) -1 0) week))))))) (autoload 'diary-make-date "diary-lib") diff --git a/lisp/calendar/holidays.el b/lisp/calendar/holidays.el index 2afa667a56c..7e11044dbc0 100644 --- a/lisp/calendar/holidays.el +++ b/lisp/calendar/holidays.el @@ -400,6 +400,36 @@ This function is suitable for execution in an init file." (displayed-year (calendar-extract-year date))) (calendar-list-holidays)))) +(defun holiday-available-holiday-lists () + "Return a list of all holiday lists. +This is used by `list-holidays', and you can customize the return +value by using `add-function'." + (delq + nil + (list + (cons "All" calendar-holidays) + (cons "Equinoxes/Solstices" + (list (list 'solar-equinoxes-solstices))) + (if holiday-general-holidays + (cons "General" holiday-general-holidays)) + (if holiday-local-holidays + (cons "Local" holiday-local-holidays)) + (if holiday-other-holidays + (cons "Other" holiday-other-holidays)) + (if holiday-christian-holidays + (cons "Christian" holiday-christian-holidays)) + (if holiday-hebrew-holidays + (cons "Hebrew" holiday-hebrew-holidays)) + (if holiday-islamic-holidays + (cons "Islamic" holiday-islamic-holidays)) + (if holiday-bahai-holidays + (cons "Bahá’Ã" holiday-bahai-holidays)) + (if holiday-oriental-holidays + (cons "Oriental" holiday-oriental-holidays)) + (if holiday-solar-holidays + (cons "Solar" holiday-solar-holidays)) + (cons "Ask" nil)))) + ;; rms: "Emacs commands to display a list of something generally start ;; with `list-'. Please make `list-holidays' the principal name." ;;;###autoload @@ -421,7 +451,12 @@ documentation of `calendar-holidays' for a list of the variables that control the choices, as well as a description of the format of a holiday list. -The optional LABEL is used to label the buffer created." +The optional LABEL is used to label the buffer created. + +The list of holiday lists is computed by the +`holiday-available-holiday-lists' and you can alter the results +by redefining that function, or use `add-function' to add +values." (interactive (let* ((start-year (calendar-read-sexp "Starting year of holidays (>0)" @@ -433,30 +468,7 @@ The optional LABEL is used to label the buffer created." start-year start-year)) (completion-ignore-case t) - (lists - (list - (cons "All" calendar-holidays) - (cons "Equinoxes/Solstices" - (list (list 'solar-equinoxes-solstices))) - (if holiday-general-holidays - (cons "General" holiday-general-holidays)) - (if holiday-local-holidays - (cons "Local" holiday-local-holidays)) - (if holiday-other-holidays - (cons "Other" holiday-other-holidays)) - (if holiday-christian-holidays - (cons "Christian" holiday-christian-holidays)) - (if holiday-hebrew-holidays - (cons "Hebrew" holiday-hebrew-holidays)) - (if holiday-islamic-holidays - (cons "Islamic" holiday-islamic-holidays)) - (if holiday-bahai-holidays - (cons "Bahá’Ã" holiday-bahai-holidays)) - (if holiday-oriental-holidays - (cons "Oriental" holiday-oriental-holidays)) - (if holiday-solar-holidays - (cons "Solar" holiday-solar-holidays)) - (cons "Ask" nil))) + (lists (holiday-available-holiday-lists)) (choice (capitalize (completing-read "List (TAB for choices): " lists nil t))) (which (if (string-equal choice "Ask") diff --git a/lisp/calendar/time-date.el b/lisp/calendar/time-date.el index 51cf7eb213f..ba7c48b290d 100644 --- a/lisp/calendar/time-date.el +++ b/lisp/calendar/time-date.el @@ -287,17 +287,23 @@ use. \"%,1s\" means \"use one decimal\". The \"%z\" specifier does not print anything. When it is used, specifiers must be given in order of decreasing size. To the left of \"%z\", nothing -is output until the first non-zero unit is encountered." +is output until the first non-zero unit is encountered. + +The \"%x\" specifier does not print anything. When it is used, +specifiers must be given in order of decreasing size. To the +right of \"%x\", trailing zero units are not output." (let ((start 0) (units '(("y" "year" 31536000) ("d" "day" 86400) ("h" "hour" 3600) ("m" "minute" 60) ("s" "second" 1) - ("z"))) + ("z") + ("x"))) (case-fold-search t) - spec match usedunits zeroflag larger prev name unit num zeropos - fraction) + spec match usedunits zeroflag larger prev name unit num + leading-zeropos trailing-zeropos fraction + chop-leading chop-trailing) (while (string-match "%\\.?[0-9]*\\(,[0-9]\\)?\\(.\\)" string start) (setq start (match-end 0) spec (match-string 2 string)) @@ -306,15 +312,16 @@ is output until the first non-zero unit is encountered." (error "Bad format specifier: `%s'" spec)) (if (assoc (downcase spec) usedunits) (error "Multiple instances of specifier: `%s'" spec)) - (if (string-equal (car match) "z") + (if (or (string-equal (car match) "z") + (string-equal (car match) "x")) (setq zeroflag t) (unless larger (setq unit (nth 2 match) larger (and prev (> unit prev)) prev unit))) (push match usedunits))) - (and zeroflag larger - (error "Units are not in decreasing order of size")) + (when (and zeroflag larger) + (error "Units are not in decreasing order of size")) (unless (numberp seconds) (setq seconds (float-time seconds))) (setq fraction (mod seconds 1) @@ -326,18 +333,28 @@ is output until the first non-zero unit is encountered." (when (string-match (format "%%\\(\\.?[0-9]+\\)?\\(,[0-9]+\\)?\\(%s\\)" spec) string) - (if (string-equal spec "z") ; must be last in units - (setq string - (replace-regexp-in-string - "%z" "" - (substring string (min (or zeropos (match-end 0)) - (match-beginning 0))))) + (cond + ((string-equal spec "z") + (setq chop-leading (and leading-zeropos + (min leading-zeropos (match-beginning 0))))) + ((string-equal spec "x") + (setq chop-trailing t)) + (t ;; Cf article-make-date-line in gnus-art. (setq num (floor seconds unit) seconds (- seconds (* num unit))) - ;; Start position of the first non-zero unit. - (or zeropos - (setq zeropos (unless (zerop num) (match-beginning 0)))) + (let ((is-zero (zerop (if (= unit 1) + (+ num fraction) + num)))) + ;; Start position of the first non-zero unit. + (when (and (not leading-zeropos) + (not is-zero)) + (setq leading-zeropos (match-beginning 0))) + (unless is-zero + (setq trailing-zeropos nil)) + (when (and (not trailing-zeropos) + is-zero) + (setq trailing-zeropos (match-beginning 0)))) (setq string (replace-match (format (if (match-string 2 string) @@ -360,7 +377,17 @@ is output until the first non-zero unit is encountered." (format " %s%s" name (if (= num 1) "" "s")))) t t string)))))) - (string-replace "%%" "%" string)) + (let ((pre string)) + (when (and chop-trailing trailing-zeropos) + (setq string (substring string 0 trailing-zeropos))) + (when chop-leading + (setq string (substring string chop-leading))) + ;; If we ended up removing everything, return the formatted + ;; string in full. + (when (equal string "") + (setq string pre))) + (setq string (replace-regexp-in-string "%[zx]" "" string))) + (string-trim (string-replace "%%" "%" string))) (defvar seconds-to-string (list (list 1 "ms" 0.001) diff --git a/lisp/cedet/ede/files.el b/lisp/cedet/ede/files.el index 3b9002a6e31..b8acb192c17 100644 --- a/lisp/cedet/ede/files.el +++ b/lisp/cedet/ede/files.el @@ -257,7 +257,7 @@ If optional EXACT is non-nil, only return exact matches for DIR." (defun ede-flush-directory-hash () "Flush the project directory hash. Do this only when developing new projects that are incorrectly putting -'nomatch tokens into the hash." +`nomatch' tokens into the hash." (interactive) (setq ede-project-directory-hash (make-hash-table :test 'equal)) ;; Also slush the current project's locator hash. diff --git a/lisp/cedet/semantic.el b/lisp/cedet/semantic.el index dc6751db6cf..78002dd8abc 100644 --- a/lisp/cedet/semantic.el +++ b/lisp/cedet/semantic.el @@ -497,8 +497,8 @@ is requested." (defvar semantic-working-type 'percent "The type of working message to use when parsing. -'percent means we are doing a linear parse through the buffer. -'dynamic means we are reparsing specific tags.") +`percent' means we are doing a linear parse through the buffer. +`dynamic' means we are reparsing specific tags.") (defvar semantic-minimum-working-buffer-size (* 1024 5) "The minimum size of a buffer before working messages are displayed. diff --git a/lisp/cedet/semantic/db.el b/lisp/cedet/semantic/db.el index 7f25a848918..82785ec6d2e 100644 --- a/lisp/cedet/semantic/db.el +++ b/lisp/cedet/semantic/db.el @@ -729,7 +729,7 @@ Exit the save between databases if there is user input." (defvar semanticdb-project-predicate-functions nil "List of predicates to try that indicate a directory belongs to a project. This list is used when `semanticdb-persistent-path' contains the value -'project. If the predicate list is nil, then presume all paths are valid. +`project'. If the predicate list is nil, then presume all paths are valid. Project Management software (such as EDE and JDE) should add their own predicates with `add-hook' to this variable, and semanticdb will save tag diff --git a/lisp/cedet/semantic/find.el b/lisp/cedet/semantic/find.el index e894022315f..92644ce0066 100644 --- a/lisp/cedet/semantic/find.el +++ b/lisp/cedet/semantic/find.el @@ -591,7 +591,7 @@ in the new list. If optional argument SEARCH-PARTS is non-nil, all sub-parts of tags are searched. The overloadable function `semantic-tag-components' is used for the searching child lists. If SEARCH-PARTS is the symbol -'positiononly, then only children that have positional information are +`positiononly', then only children that have positional information are searched. If SEARCH-INCLUDES has not been implemented. diff --git a/lisp/cedet/semantic/java.el b/lisp/cedet/semantic/java.el index a7c02032e22..9b70afd0a33 100644 --- a/lisp/cedet/semantic/java.el +++ b/lisp/cedet/semantic/java.el @@ -391,7 +391,7 @@ That is TAG `symbol-name' without the leading `@'." Return the list of FUN results. If optional PROPERTY is non-nil only call FUN for javadoc keywords which have a value for PROPERTY. FUN receives two arguments: the javadoc keyword and its associated -'javadoc property list. It can return any value. All nil values are +`javadoc' property list. It can return any value. All nil values are removed from the result list." (delq nil (mapcar diff --git a/lisp/cedet/semantic/lex-spp.el b/lisp/cedet/semantic/lex-spp.el index 26a3b39f0d6..57e59f4e9fe 100644 --- a/lisp/cedet/semantic/lex-spp.el +++ b/lisp/cedet/semantic/lex-spp.el @@ -726,7 +726,7 @@ Returns position with the end of that macro." (point)))))) (defun semantic-lex-spp-get-overlay (&optional point) - "Return first overlay which has a 'semantic-spp property." + "Return first overlay which has a `semantic-spp' property." (let ((overlays (overlays-at (or point (point))))) (while (and overlays (null (overlay-get (car overlays) 'semantic-spp))) diff --git a/lisp/cedet/semantic/symref.el b/lisp/cedet/semantic/symref.el index ba236059f66..e48cefa4ca6 100644 --- a/lisp/cedet/semantic/symref.el +++ b/lisp/cedet/semantic/symref.el @@ -101,7 +101,7 @@ Where PREDICATE is a function that takes a directory name for the root of a project, and returns non-nil if the tool represented by KEY is supported. -If no tools are supported, then 'grep is assumed.") +If no tools are supported, then `grep' is assumed.") (defun semantic-symref-calculate-rootdir () "Calculate the root directory for a symref search. @@ -475,7 +475,7 @@ already." Return the Semantic tag associated with HIT. SEARCHTXT is the text that is being searched for. Used to narrow the in-buffer search. -SEARCHTYPE is the type of search (such as 'symbol or 'tagname). +SEARCHTYPE is the type of search (such as `symbol' or `tagname'). If there is no database, or if the searchtype is wrong, return nil." ;; Allowed search types for this mechanism: ;; tagname, tagregexp, tagcompletions @@ -506,7 +506,7 @@ If there is no database, or if the searchtype is wrong, return nil." Return the Semantic tag associated with HIT. SEARCHTXT is the text that is being searched for. Used to narrow the in-buffer search. -SEARCHTYPE is the type of search (such as 'symbol or 'tagname). +SEARCHTYPE is the type of search (such as `symbol' or `tagname'). Optional OPEN-BUFFERS, when nil will use a faster version of `find-file' when a file needs to be opened. If non-nil, then normal buffer initialization will be used. diff --git a/lisp/comint.el b/lisp/comint.el index 56082f622a5..88eaf1120e3 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -1110,7 +1110,8 @@ See also `comint-read-input-ring'." (use-local-map keymap)) (forward-line 3) (while (search-backward "completion" nil 'move) - (replace-match "history reference"))) + (replace-match (apply #'propertize "history reference" + (text-properties-at (point)))))) (sit-for 0) (message "Hit space to flush") (setq comint-dynamic-list-input-ring-window-conf conf) diff --git a/lisp/descr-text.el b/lisp/descr-text.el index a8160889325..0f01ad676ae 100644 --- a/lisp/descr-text.el +++ b/lisp/descr-text.el @@ -176,6 +176,10 @@ otherwise." (insert "\n")) ;; Text properties (when properties + (when (plist-get properties 'invisible) + (insert "\nNote that character has an invisibility property,\n" + " so the character displayed at point in the buffer may\n" + " differ from the character described here.\n")) (newline) (insert "There are text properties here:\n") (describe-property-list properties))))) diff --git a/lisp/desktop.el b/lisp/desktop.el index 7e3d66bdf1f..1a4103e2090 100644 --- a/lisp/desktop.el +++ b/lisp/desktop.el @@ -434,7 +434,9 @@ If `all', also restores frames that are partially offscreen onscreen. Note that checking of frame boundaries is only approximate. It can fail to reliably detect frames whose onscreen/offscreen state depends on a few pixels, especially near the right / bottom borders -of the screen." +of the screen. +Text-mode frames are always considered onscreen, so this option has +no effect on restoring frames in a non-GUI session." :type '(choice (const :tag "Only fully offscreen frames" t) (const :tag "Also partially offscreen frames" all) (const :tag "Do not force frames onscreen" nil)) @@ -645,6 +647,14 @@ Only valid during frame saving & restoring; intended for internal use.") "When the desktop file was last modified to the knowledge of this Emacs. Used to detect desktop file conflicts.") +(defun desktop--get-file-modtime () + "Get desktop file modtime, in list form for desktop format version 208." + (setq desktop-file-modtime + (time-convert (file-attribute-modification-time + (file-attributes + (desktop-full-file-name))) + 'list))) + (defvar desktop-var-serdes-funs (list (list 'mark-ring @@ -847,15 +857,16 @@ buffer, which is (in order): ,(buffer-name) ,major-mode ;; minor modes - ,(let (ret) - (dolist (minor-mode (mapcar #'car minor-mode-alist) ret) - (and (boundp minor-mode) - (symbol-value minor-mode) - (let* ((special (assq minor-mode desktop-minor-mode-table)) - (value (cond (special (cadr special)) - ((get minor-mode :minor-mode-function)) - ((functionp minor-mode) minor-mode)))) - (when value (cl-pushnew value ret)))))) + ,(seq-filter + (lambda (minor-mode) + ;; Just two sanity checks. + (and (boundp minor-mode) + (symbol-value minor-mode) + (let ((special + (assq minor-mode desktop-minor-mode-table))) + (or (not special) + (cadr special))))) + local-minor-modes) ;; point and mark, and read-only status ,(point) ,(list (mark t) mark-active) @@ -1120,7 +1131,7 @@ no questions asked." (file-attributes (desktop-full-file-name))))) (when (or (not new-modtime) ; nothing to overwrite - (equal desktop-file-modtime new-modtime) + (time-equal-p desktop-file-modtime new-modtime) (yes-or-no-p (if desktop-file-modtime (if (time-less-p desktop-file-modtime new-modtime) @@ -1220,9 +1231,7 @@ no questions asked." (write-region (point-min) (point-max) (desktop-full-file-name) nil 'nomessage)) (setq desktop-file-checksum checksum) ;; We remember when it was modified (which is presumably just now). - (setq desktop-file-modtime (file-attribute-modification-time - (file-attributes - (desktop-full-file-name))))))))))) + (desktop--get-file-modtime)))))))) ;; ---------------------------------------------------------------------------- ;;;###autoload @@ -1244,7 +1253,11 @@ This function also sets `desktop-dirname' to nil." ;; ---------------------------------------------------------------------------- (defun desktop-restoring-frameset-p () "True if calling `desktop-restore-frameset' will actually restore it." - (and desktop-restore-frames desktop-saved-frameset (display-graphic-p) t)) + (and desktop-restore-frames desktop-saved-frameset + ;; Don't restore frames when the selected frame is the daemon's + ;; initial frame. + (not (and (daemonp) (not (frame-parameter nil 'client)))) + t)) (defun desktop-restore-frameset () "Restore the state of a set of frames. @@ -1255,7 +1268,17 @@ being set (usually, by reading it from the desktop)." :reuse-frames (eq desktop-restore-reuses-frames t) :cleanup-frames (not (eq desktop-restore-reuses-frames 'keep)) :force-display desktop-restore-in-current-display - :force-onscreen desktop-restore-forces-onscreen))) + :force-onscreen (and desktop-restore-forces-onscreen + (display-graphic-p))) + ;; When at least one restored frame contains a tab bar, + ;; enable `tab-bar-mode' that takes care about recalculating + ;; the correct values of the frame parameter `tab-bar-lines' + ;; (that depends on `tab-bar-show'), and also loads graphical buttons. + (when (seq-some + (lambda (frame) + (menu-bar-positive-p (frame-parameter frame 'tab-bar-lines))) + (frame-list)) + (tab-bar-mode 1)))) ;; Just to silence the byte compiler. ;; Dynamically bound in `desktop-read'. @@ -1331,9 +1354,7 @@ It returns t if a desktop file was loaded, nil otherwise. 'window-configuration-change-hook))) (desktop-auto-save-disable) ;; Evaluate desktop buffer and remember when it was modified. - (setq desktop-file-modtime (file-attribute-modification-time - (file-attributes - (desktop-full-file-name)))) + (desktop--get-file-modtime) (load (desktop-full-file-name) t t t) ;; If it wasn't already, mark it as in-use, to bother other ;; desktop instances. diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index c49e4e91d83..ae033618c24 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -1896,22 +1896,23 @@ rename them using `vc-rename-file'." "Rename FILE to NEWNAME. Signal a `file-already-exists' error if a file NEWNAME already exists unless OK-IF-ALREADY-EXISTS is non-nil." - (dired-handle-overwrite newname) - (dired-maybe-create-dirs (file-name-directory newname)) - (if (and dired-vc-rename-file - (vc-backend file) - (ignore-errors (vc-responsible-backend newname))) - (vc-rename-file file newname) - ;; error is caught in -create-files - (rename-file file newname ok-if-already-exists)) - ;; Silently rename the visited file of any buffer visiting this file. - (and (get-file-buffer file) - (with-current-buffer (get-file-buffer file) - (set-visited-file-name newname nil t))) - (dired-remove-file file) - ;; See if it's an inserted subdir, and rename that, too. - (when (file-directory-p file) - (dired-rename-subdir file newname))) + (let ((file-is-dir-p (file-directory-p file))) + (dired-handle-overwrite newname) + (dired-maybe-create-dirs (file-name-directory newname)) + (if (and dired-vc-rename-file + (vc-backend file) + (ignore-errors (vc-responsible-backend newname))) + (vc-rename-file file newname) + ;; error is caught in -create-files + (rename-file file newname ok-if-already-exists)) + ;; Silently rename the visited file of any buffer visiting this file. + (and (get-file-buffer file) + (with-current-buffer (get-file-buffer file) + (set-visited-file-name newname nil t))) + (dired-remove-file file) + ;; See if it's an inserted subdir, and rename that, too. + (when file-is-dir-p + (dired-rename-subdir file newname)))) (defun dired-rename-subdir (from-dir to-dir) (setq from-dir (file-name-as-directory from-dir) @@ -1924,7 +1925,7 @@ unless OK-IF-ALREADY-EXISTS is non-nil." (while blist (with-current-buffer (car blist) (if (and buffer-file-name - (file-in-directory-p buffer-file-name expanded-from-dir)) + (dired-in-this-tree-p buffer-file-name expanded-from-dir)) (let ((modflag (buffer-modified-p)) (to-file (replace-regexp-in-string (concat "^" (regexp-quote from-dir)) @@ -1943,7 +1944,7 @@ unless OK-IF-ALREADY-EXISTS is non-nil." (while alist (setq elt (car alist) alist (cdr alist)) - (if (file-in-directory-p (car elt) expanded-dir) + (if (dired-in-this-tree-p (car elt) expanded-dir) ;; ELT's subdir is affected by the rename (dired-rename-subdir-2 elt dir to))) (if (equal dir default-directory) @@ -2468,6 +2469,10 @@ If `dired-copy-preserve-time' is non-nil, this command preserves the modification time of each old file in the copy, similar to the \"-p\" option for the \"cp\" shell command. +The `dired-keep-marker-copy' user option controls how this +command handles file marking. The default is to mark all new +copies of files with a \"C\" mark. + This command copies symbolic links by creating new ones, similar to the \"-d\" option for the \"cp\" shell command. But if `dired-copy-dereference' is non-nil, the symbolic @@ -3280,9 +3285,14 @@ To continue searching for next match, use command \\[fileloop-continue]." ;;;###autoload (defun dired-do-query-replace-regexp (from to &optional delimited) "Do `query-replace-regexp' of FROM with TO, on all marked files. +As each match is found, the user must type a character saying +what to do with it. Type SPC or `y' to replace the match, +DEL or `n' to skip and go to the next match. For more directions, +type \\[help-command] at that time. + Third arg DELIMITED (prefix arg) means replace only word-delimited matches. -If you exit (\\[keyboard-quit], RET or q), you can resume the query replace -with the command \\[tags-loop-continue]." +If you exit the query-replace loop (\\[keyboard-quit], RET or q), you can +resume the query replace with the command \\[tags-loop-continue]." (interactive (let ((common (query-replace-read-args @@ -3334,7 +3344,7 @@ REGEXP should use constructs supported by your local `grep' command." (project--files-in-directory mark ignores "*") files)) (push mark files))) - (nreverse marks)) + (reverse marks)) (message "Searching...") (setq xrefs (xref-matches-in-files regexp files)) @@ -3348,6 +3358,11 @@ REGEXP should use constructs supported by your local `grep' command." (defun dired-do-find-regexp-and-replace (from to) "Replace matches of FROM with TO, in all marked files. +As each match is found, the user must type a character saying +what to do with it. Type SPC or `y' to replace the match, +DEL or `n' to skip and go to the next match. For more directions, +type \\[help-command] at that time. + If no files are marked, use the file under point. For any marked directory, matches in all of its files are replaced, @@ -3355,7 +3370,10 @@ recursively. However, files matching `grep-find-ignored-files' and subdirectories matching `grep-find-ignored-directories' are skipped in the marked directories. -REGEXP should use constructs supported by your local `grep' command." +REGEXP should use constructs supported by your local `grep' command. + +Also see `query-replace' for user options that affect how this +function works." (interactive (let ((common (query-replace-read-args diff --git a/lisp/dired.el b/lisp/dired.el index 5accad8efd2..89fbd52aa62 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -1034,8 +1034,11 @@ If a directory or nothing is found at point, return nil." ;;;###autoload (defun dired (dirname &optional switches) "\"Edit\" directory DIRNAME--delete, rename, print, etc. some files in it. -Optional second argument SWITCHES specifies the `ls' options used. -\(Interactively, use a prefix argument to be able to specify SWITCHES.) +Optional second argument SWITCHES specifies the options to be used +when invoking `insert-directory-program', usually `ls', which produces +the listing of the directory files and their attributes. +Interactively, a prefix argument will cause the command to prompt +for SWITCHES. If DIRNAME is a string, Dired displays a list of files in DIRNAME (which may also have shell wildcards appended to select certain files). @@ -2530,6 +2533,8 @@ If the current buffer can be edited with Wdired, (i.e. the major mode is `dired-mode'), call `wdired-change-to-wdired-mode'. Otherwise, toggle `read-only-mode'." (interactive) + (unless (file-exists-p default-directory) + (user-error "The current directory no longer exists")) (when (and (not (file-writable-p default-directory)) (not (y-or-n-p "Directory isn't writable; edit anyway? "))) @@ -3063,12 +3068,10 @@ You can then feed the file name(s) to other commands with \\[yank]." ;;; Keeping Dired buffers in sync with the filesystem and with each other -(defun dired-buffers-for-dir (dir &optional file subdirs) +(defun dired-buffers-for-dir (dir &optional file) "Return a list of buffers for DIR (top level or in-situ subdir). If FILE is non-nil, include only those whose wildcard pattern (if any) matches FILE. -If SUBDIRS is non-nil, also include the dired buffers of -directories below DIR. The list is in reverse order of buffer creation, most recent last. As a side effect, killed dired buffers for DIR are removed from `dired-buffers'." @@ -3080,20 +3083,35 @@ As a side effect, killed dired buffers for DIR are removed from ((null (buffer-name buf)) ;; Buffer is killed - clean up: (setq dired-buffers (delq elt dired-buffers))) - ((dired-in-this-tree-p (car elt) dir) + ((dired-in-this-tree-p dir (car elt)) (with-current-buffer buf - (when (and (or subdirs - (assoc dir dired-subdir-alist)) - (or (null file) - (if (stringp dired-directory) - (let ((wildcards (file-name-nondirectory - dired-directory))) - (or (zerop (length wildcards)) - (string-match-p (dired-glob-regexp wildcards) - file))) - (member (expand-file-name file dir) - (cdr dired-directory))))) - (setq result (cons buf result))))))) + (and (assoc dir dired-subdir-alist) + (or (null file) + (if (stringp dired-directory) + (let ((wildcards (file-name-nondirectory + dired-directory))) + (or (zerop (length wildcards)) + (string-match-p (dired-glob-regexp wildcards) + file))) + (member (expand-file-name file dir) + (cdr dired-directory)))) + (setq result (cons buf result))))))) + result)) + +(defun dired-buffers-for-dir-or-subdir (dir) + "Return a list of buffers for DIR or a subdirectory thereof. +As a side effect, killed dired buffers for DIR are removed from +`dired-buffers'." + (setq dir (file-name-as-directory dir)) + (let (result buf) + (dolist (elt dired-buffers) + (setq buf (cdr elt)) + (cond + ((null (buffer-name buf)) + ;; Buffer is killed - clean up: + (setq dired-buffers (delq elt dired-buffers))) + ((dired-in-this-tree-p (car elt) dir) + (setq result (cons buf result))))) result)) (defun dired-glob-regexp (pattern) @@ -3672,14 +3690,16 @@ confirmation. To disable the confirmation, see (file-name-nondirectory fn)))) (not dired-clean-confirm-killing-deleted-buffers)) (kill-buffer buf))) - (let ((buf-list (dired-buffers-for-dir fn nil 'subdirs))) + (let ((buf-list (dired-buffers-for-dir-or-subdir + (expand-file-name fn)))) (and buf-list (or (and dired-clean-confirm-killing-deleted-buffers (y-or-n-p (format - (ngettext "Kill Dired buffer of %s, too? " - "Kill Dired buffers of %s, too? " - (length buf-list)) + (ngettext + "Kill Dired buffer of %s, too? " + "Kill Dired buffers of %s and its sub-directories, too? " + (length buf-list)) (file-name-nondirectory ;; FN may end in a / if `dired-listing-switches' ;; contains -p, so we need to strip that diff --git a/lisp/doc-view.el b/lisp/doc-view.el index 5b07d75f6d8..22570dd5103 100644 --- a/lisp/doc-view.el +++ b/lisp/doc-view.el @@ -234,8 +234,8 @@ Higher values result in larger images." (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'.") +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! @@ -632,17 +632,16 @@ Typically \"page-%s.png\".") (propertize (format "Page %d of %d." page len) 'face 'bold) ;; Tell user if converting isn't finished yet - (if doc-view--current-converter-processes - " (still converting...)\n" - "\n") - ;; Display context infos if this page matches the last search - (when (and doc-view--current-search-matches - (assq page doc-view--current-search-matches)) - (concat (propertize "Search matches:\n" 'face 'bold) + (and doc-view--current-converter-processes + " (still converting...)") + ;; Display context infos if this page matches the last search + (when (and doc-view--current-search-matches + (assq page doc-view--current-search-matches)) + (concat "\n" (propertize "Search matches:" 'face 'bold) (let ((contexts "")) (dolist (m (cdr (assq page doc-view--current-search-matches))) - (setq contexts (concat contexts " - \"" m "\"\n"))) + (setq contexts (concat contexts "\n - \"" m "\""))) contexts))))) ;; Update the buffer ;; We used to find the file name from doc-view--current-files but @@ -1947,8 +1946,7 @@ If BACKWARD is non-nil, jump to the previous match." ;; 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)) - )))) + ((looking-at "PK") '(epub odf)))))) (setq-local doc-view-doc-type (car (or (nreverse (seq-intersection name-types content-types #'eq)) diff --git a/lisp/ehelp.el b/lisp/ehelp.el index 8c1555249ca..0c2f02639fc 100644 --- a/lisp/ehelp.el +++ b/lisp/ehelp.el @@ -76,7 +76,10 @@ (define-key map [?\C-7] 'electric-help-undefined) (define-key map [?\C-8] 'electric-help-undefined) (define-key map [?\C-9] 'electric-help-undefined) - (define-key map (char-to-string help-char) 'electric-help-help) + (define-key map (if (characterp help-char) + (char-to-string help-char) + (vector help-char)) + 'electric-help-help) (define-key map "?" 'electric-help-help) (define-key map " " 'scroll-up) (define-key map [?\S-\ ] 'scroll-down) diff --git a/lisp/elec-pair.el b/lisp/elec-pair.el index c3fd90e5bfd..231dcdeb980 100644 --- a/lisp/elec-pair.el +++ b/lisp/elec-pair.el @@ -256,7 +256,7 @@ cache is flushed from position START, defaulting to point." (defun electric-pair--syntax-ppss (&optional pos where) "Like `syntax-ppss', but sometimes fallback to `parse-partial-sexp'. -WHERE is a list defaulting to '(string comment) and indicates +WHERE is a list defaulting to \\='(string comment) and indicates when to fallback to `parse-partial-sexp'." (let* ((pos (or pos (point))) (where (or where '(string comment))) diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el index 8e43ae68072..86a42b208e7 100644 --- a/lisp/emacs-lisp/advice.el +++ b/lisp/emacs-lisp/advice.el @@ -1814,8 +1814,7 @@ Redefining advices affect the construction of an advised definition." (if (symbolp function) (setq function (if (fboundp function) (advice--strip-macro (symbol-function function))))) - (while (advice--p function) (setq function (advice--cdr function))) - function) + (advice--cd*r function)) (defun ad-clear-advicefunname-definition (function) (let ((advicefunname (ad-get-advice-info-field function 'advicefunname))) diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 39bb6224595..d3d8405d068 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -338,7 +338,7 @@ for speeding up processing.") (let ((exps-opt (byte-optimize-body exps t))) (if (macroexp-const-p exp-opt) `(progn ,@exps-opt ,exp-opt) - `(prog1 ,exp-opt ,@exps-opt))) + `(,fn ,exp-opt ,@exps-opt))) exp-opt))) (`(,(or `save-excursion `save-restriction `save-current-buffer) . ,exps) @@ -358,7 +358,7 @@ for speeding up processing.") (then-opt (and test-opt (byte-optimize-form then for-effect))) (else-opt (and (not (and test-opt const)) (byte-optimize-body else for-effect)))) - `(if ,test-opt ,then-opt . ,else-opt))) + `(,fn ,test-opt ,then-opt . ,else-opt))) (`(,(or 'and 'or) . ,exps) ;; FIXME: We have to traverse the expressions in left-to-right @@ -397,7 +397,7 @@ for speeding up processing.") ;; as mutated variables have been marked as non-substitutable. (condition (byte-optimize-form (car condition-body) nil)) (body (byte-optimize-body (cdr condition-body) t))) - `(while ,condition . ,body))) + `(,fn ,condition . ,body))) (`(interactive . ,_) (byte-compile-warn-x form "misplaced interactive spec: `%s'" form) @@ -409,7 +409,7 @@ for speeding up processing.") form) (`(condition-case ,var ,exp . ,clauses) - `(condition-case ,var ;Not evaluated. + `(,fn ,var ;Not evaluated. ,(byte-optimize-form exp for-effect) ,@(mapcar (lambda (clause) (let ((byte-optimize--lexvars @@ -432,14 +432,14 @@ for speeding up processing.") (let ((bodyform (byte-optimize-form exp for-effect))) (pcase exps (`(:fun-body ,f) - `(unwind-protect ,bodyform + `(,fn ,bodyform :fun-body ,(byte-optimize-form f nil))) (_ - `(unwind-protect ,bodyform + `(,fn ,bodyform . ,(byte-optimize-body exps t)))))) (`(catch ,tag . ,exps) - `(catch ,(byte-optimize-form tag nil) + `(,fn ,(byte-optimize-form tag nil) . ,(byte-optimize-body exps for-effect))) ;; Needed as long as we run byte-optimize-form after cconv. @@ -495,7 +495,7 @@ for speeding up processing.") (cons (byte-optimize-form (car rest) nil) (cdr rest))))) (push name byte-optimize--dynamic-vars) - `(defvar ,name . ,optimized-rest))) + `(,fn ,name . ,optimized-rest))) (`(,(pred byte-code-function-p) . ,exps) (cons fn (mapcar #'byte-optimize-form exps))) @@ -561,49 +561,50 @@ for speeding up processing.") (defun byte-optimize--rename-var (var new-var form) "Replace VAR with NEW-VAR in FORM." - (pcase form - ((pred symbolp) (if (eq form var) new-var form)) - (`(setq . ,args) - (let ((new-args nil)) - (while args - (push (byte-optimize--rename-var var new-var (car args)) new-args) - (push (byte-optimize--rename-var var new-var (cadr args)) new-args) - (setq args (cddr args))) - `(setq . ,(nreverse new-args)))) - ;; In binding constructs like `let', `let*' and `condition-case' we - ;; rename everything for simplicity, even new bindings named VAR. - (`(,(and head (or 'let 'let*)) ,bindings . ,body) - `(,head - ,(mapcar (lambda (b) (byte-optimize--rename-var-body var new-var b)) - bindings) - ,@(byte-optimize--rename-var-body var new-var body))) - (`(condition-case ,res-var ,protected-form . ,handlers) - `(condition-case ,(byte-optimize--rename-var var new-var res-var) - ,(byte-optimize--rename-var var new-var protected-form) - ,@(mapcar (lambda (h) - (cons (car h) - (byte-optimize--rename-var-body var new-var (cdr h)))) - handlers))) - (`(internal-make-closure ,vars ,env . ,rest) - `(internal-make-closure - ,vars ,(byte-optimize--rename-var-body var new-var env) . ,rest)) - (`(defvar ,name . ,rest) - ;; NAME is not renamed here; we only care about lexical variables. - `(defvar ,name . ,(byte-optimize--rename-var-body var new-var rest))) - - (`(cond . ,clauses) - `(cond ,@(mapcar (lambda (c) - (byte-optimize--rename-var-body var new-var c)) - clauses))) - - (`(function . ,_) form) - (`(quote . ,_) form) - (`(lambda . ,_) form) - - ;; Function calls and special forms not handled above. - (`(,head . ,args) - `(,head . ,(byte-optimize--rename-var-body var new-var args))) - (_ form))) + (let ((fn (car-safe form))) + (pcase form + ((pred symbolp) (if (eq form var) new-var form)) + (`(setq . ,args) + (let ((new-args nil)) + (while args + (push (byte-optimize--rename-var var new-var (car args)) new-args) + (push (byte-optimize--rename-var var new-var (cadr args)) new-args) + (setq args (cddr args))) + `(,fn . ,(nreverse new-args)))) + ;; In binding constructs like `let', `let*' and `condition-case' we + ;; rename everything for simplicity, even new bindings named VAR. + (`(,(and head (or 'let 'let*)) ,bindings . ,body) + `(,head + ,(mapcar (lambda (b) (byte-optimize--rename-var-body var new-var b)) + bindings) + ,@(byte-optimize--rename-var-body var new-var body))) + (`(condition-case ,res-var ,protected-form . ,handlers) + `(,fn ,(byte-optimize--rename-var var new-var res-var) + ,(byte-optimize--rename-var var new-var protected-form) + ,@(mapcar (lambda (h) + (cons (car h) + (byte-optimize--rename-var-body var new-var (cdr h)))) + handlers))) + (`(internal-make-closure ,vars ,env . ,rest) + `(,fn + ,vars ,(byte-optimize--rename-var-body var new-var env) . ,rest)) + (`(defvar ,name . ,rest) + ;; NAME is not renamed here; we only care about lexical variables. + `(,fn ,name . ,(byte-optimize--rename-var-body var new-var rest))) + + (`(cond . ,clauses) + `(,fn ,@(mapcar (lambda (c) + (byte-optimize--rename-var-body var new-var c)) + clauses))) + + (`(function . ,_) form) + (`(quote . ,_) form) + (`(lambda . ,_) form) + + ;; Function calls and special forms not handled above. + (`(,head . ,args) + `(,head . ,(byte-optimize--rename-var-body var new-var args))) + (_ form)))) (defun byte-optimize-let-form (head form for-effect) ;; Recursively enter the optimizer for the bindings and body @@ -1174,21 +1175,21 @@ See Info node `(elisp) Integer Basics'." (proper-list-p clause)) (if (null (cddr clause)) ;; A trivial `progn'. - (byte-optimize-if `(if ,(cadr clause) ,@(nthcdr 2 form))) + (byte-optimize-if `(,(car form) ,(cadr clause) ,@(nthcdr 2 form))) (nconc (butlast clause) (list (byte-optimize-if - `(if ,(car (last clause)) ,@(nthcdr 2 form))))))) + `(,(car form) ,(car (last clause)) ,@(nthcdr 2 form))))))) ((byte-compile-trueconstp clause) `(progn ,clause ,(nth 2 form))) ((byte-compile-nilconstp clause) `(progn ,clause ,@(nthcdr 3 form))) ((nth 2 form) (if (equal '(nil) (nthcdr 3 form)) - (list 'if clause (nth 2 form)) + (list (car form) clause (nth 2 form)) form)) ((or (nth 3 form) (nthcdr 4 form)) - (list 'if + (list (car form) ;; Don't make a double negative; ;; instead, take away the one that is there. (if (and (consp clause) (memq (car clause) '(not null)) @@ -1267,7 +1268,7 @@ See Info node `(elisp) Integer Basics'." (and (consp binding) (cadr binding))) bindings) ,const) - `(let* ,(butlast bindings) + `(,head ,(butlast bindings) ,@(and (consp (car (last bindings))) (cdar (last bindings))) ,const))) @@ -1282,7 +1283,7 @@ See Info node `(elisp) Integer Basics'." `(progn ,@(mapcar (lambda (binding) (and (consp binding) (cadr binding))) bindings)) - `(let* ,(butlast bindings) + `(,head ,(butlast bindings) ,@(and (consp (car (last bindings))) (cdar (last bindings)))))) diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index 384e8cba88f..0113051c8eb 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el @@ -32,8 +32,7 @@ (defvar byte-run--ssp-seen nil "Which conses/vectors/records have been processed in strip-symbol-positions? -The value is a hash table, the key being the old element and the value being -the corresponding new element of the same type. +The value is a hash table, the keys being the elements and the values being t. The purpose of this is to detect circular structures.") diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index c39d931517e..c0dffe544cf 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -471,7 +471,7 @@ Return the compile-time value of FORM." (let ((print-symbols-bare t)) ; Possibly redundant binding. (setf form (macroexp-macroexpand form byte-compile-macro-environment))) (if (eq (car-safe form) 'progn) - (cons 'progn + (cons (car form) (mapcar (lambda (subform) (byte-compile-recurse-toplevel subform non-toplevel-case)) @@ -1009,13 +1009,22 @@ CONST2 may be evaluated multiple times." ;; Similarly, replace TAGs in all jump tables with the correct PC index. (dolist (hash-table byte-compile-jump-tables) - (maphash #'(lambda (value tag) - (setq pc (cadr tag)) - ;; We don't need to split PC here, as it is stored as a lisp - ;; object in the hash table (whereas other goto-* ops store - ;; it within 2 bytes in the byte string). - (puthash value pc hash-table)) - hash-table)) + (let (alist) + (maphash #'(lambda (value tag) + (setq pc (cadr tag)) + ;; We don't need to split PC here, as it is stored as a + ;; lisp object in the hash table (whereas other goto-* + ;; ops store it within 2 bytes in the byte string). + ;; De-position any symbols with position in `value'. + ;; Since this may change the hash table key, we remove + ;; the entry from the table and reinsert it outside the + ;; scope of the `maphash'. + (setq value (byte-run-strip-symbol-positions value)) + (push (cons value pc) alist) + (remhash value hash-table)) + hash-table) + (dolist (elt alist) + (puthash (car elt) (cdr elt) hash-table)))) (let ((bytecode (apply 'unibyte-string (nreverse bytes)))) (when byte-native-compiling ;; Spill LAP for the native compiler here. @@ -1164,27 +1173,27 @@ message buffer `default-directory'." (f2 (file-relative-name file dir))) (if (< (length f2) (length f1)) f2 f1))) -(defun byte-compile--first-symbol (form) - "Return the \"first\" symbol found in form, or 0 if there is none. +(defun byte-compile--first-symbol-with-pos (form) + "Return the \"first\" symbol with position found in form, or 0 if none. Here, \"first\" is by a depth first search." (let (sym) (cond - ((symbolp form) form) + ((symbol-with-pos-p form) form) ((consp form) - (or (and (symbolp (setq sym (byte-compile--first-symbol (car form)))) + (or (and (symbol-with-pos-p (setq sym (byte-compile--first-symbol-with-pos (car form)))) sym) - (and (symbolp (setq sym (byte-compile--first-symbol (cdr form)))) + (and (symbolp (setq sym (byte-compile--first-symbol-with-pos (cdr form)))) sym) 0)) - ((and (vectorp form) + ((and (or (vectorp form) (recordp form)) (> (length form) 0)) (let ((i 0) (len (length form)) elt) (catch 'sym (while (< i len) - (when (symbolp - (setq elt (byte-compile--first-symbol (aref form i)))) + (when (symbol-with-pos-p + (setq elt (byte-compile--first-symbol-with-pos (aref form i)))) (throw 'sym elt)) (setq i (1+ i))) 0))) @@ -1195,7 +1204,7 @@ Here, \"first\" is by a depth first search." Return nil if such is not found." (catch 'offset (dolist (form byte-compile-form-stack) - (let ((s (byte-compile--first-symbol form))) + (let ((s (byte-compile--first-symbol-with-pos form))) (if (symbol-with-pos-p s) (throw 'offset (symbol-with-pos-pos s))))))) @@ -1430,7 +1439,7 @@ when printing the error message." (and (eq 'macro (car-safe f)) (setq f (cdr f))) ;; Advice wrappers have "catch all" args, so fetch the actual underlying ;; function to find the real arguments. - (while (advice--p f) (setq f (advice--cdr f))) + (setq f (advice--cd*r f)) (if (eq (car-safe f) 'declared) (byte-compile-arglist-signature (nth 1 f)) (condition-case nil @@ -3075,7 +3084,7 @@ lambda-expression." ;; which may include "calls" to ;; internal-make-closure (Bug#29988). lexical-binding) - (setq int `(interactive ,newform))))) + (setq int `(,(car int) ,newform))))) ((cdr int) ; Invalid (interactive . something). (byte-compile-warn-x int "malformed interactive spec: %s" int)))) diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index be4fea7be14..4535f1aa6eb 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -500,11 +500,11 @@ places where they originally did not directly appear." args))) (`(cond . ,cond-forms) ; cond special form - `(cond . ,(mapcar (lambda (branch) - (mapcar (lambda (form) - (cconv-convert form env extend)) - branch)) - cond-forms))) + `(,(car form) . ,(mapcar (lambda (branch) + (mapcar (lambda (form) + (cconv-convert form env extend)) + branch)) + cond-forms))) (`(function (lambda ,args . ,body) . ,_) (let ((docstring (if (eq :documentation (car-safe (car body))) @@ -538,7 +538,7 @@ places where they originally did not directly appear." (msg (when (eq class :unused) (cconv--warn-unused-msg var "variable"))) (newprotform (cconv-convert protected-form env extend))) - `(condition-case ,var + `(,(car form) ,var ,(if msg (macroexp--warn-wrap var msg newprotform 'lexical) newprotform) @@ -554,9 +554,9 @@ places where they originally did not directly appear." `((let ((,var (list ,var))) ,@body)))))) handlers)))) - (`(unwind-protect ,form . ,body) - `(unwind-protect ,(cconv-convert form env extend) - :fun-body ,(cconv--convert-function () body env form))) + (`(unwind-protect ,form1 . ,body) + `(,(car form) ,(cconv-convert form1 env extend) + :fun-body ,(cconv--convert-function () body env form1))) (`(setq . ,forms) ; setq special form (if (= (logand (length forms) 1) 1) @@ -568,7 +568,7 @@ places where they originally did not directly appear." (sym-new (or (cdr (assq sym env)) sym)) (value (cconv-convert (pop forms) env extend))) (push (pcase sym-new - ((pred symbolp) `(setq ,sym-new ,value)) + ((pred symbolp) `(,(car form) ,sym-new ,value)) (`(car-safe ,iexp) `(setcar ,iexp ,value)) ;; This "should never happen", but for variables which are ;; mutated+captured+unused, we may end up trying to `setq' @@ -604,7 +604,7 @@ places where they originally did not directly appear." (cons fun args))))))) (`(interactive . ,forms) - `(interactive . ,(mapcar (lambda (form) + `(,(car form) . ,(mapcar (lambda (form) (cconv-convert form nil nil)) forms))) diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el index ed9b1b7d836..8e38df43c87 100644 --- a/lisp/emacs-lisp/cl-extra.el +++ b/lisp/emacs-lisp/cl-extra.el @@ -553,10 +553,14 @@ too large if positive or too small if negative)." ,new))))) (seq-subseq seq start end)) +;;; This isn't a defalias because autoloading defalises doesn't work +;;; very well. + ;;;###autoload -(defalias 'cl-concatenate #'seq-concatenate +(defun cl-concatenate (type &rest sequences) "Concatenate, into a sequence of type TYPE, the argument SEQUENCEs. -\n(fn TYPE SEQUENCE...)") +\n(fn TYPE SEQUENCE...)" + (apply #'seq-concatenate type sequences)) ;;; List functions. diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index 179310c145b..200af057cd7 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -1078,6 +1078,19 @@ MET-NAME is as returned by `cl--generic-load-hist-format'." (setq combined-args (append (nreverse combined-args) args)) (list qual-string combined-args doconly))) +(defun cl--generic-upcase-formal-args (args) + (mapcar (lambda (arg) + (cond + ((symbolp arg) + (let ((name (symbol-name arg))) + (if (eq ?& (aref name 0)) arg + (intern (upcase name))))) + ((consp arg) + (cons (intern (upcase (symbol-name (car arg)))) + (cdr arg))) + (t arg))) + args)) + (add-hook 'help-fns-describe-function-functions #'cl--generic-describe) (defun cl--generic-describe (function) ;; Supposedly this is called from help-fns, so help-fns should be loaded at @@ -1094,14 +1107,20 @@ MET-NAME is as returned by `cl--generic-load-hist-format'." (insert (propertize "Implementations:\n\n" 'face 'bold)) ;; Loop over fanciful generics (dolist (method (cl--generic-method-table generic)) - (let* ((info (cl--generic-method-info method))) + (pcase-let* + ((`(,qualifiers ,args ,doc) (cl--generic-method-info method))) ;; FIXME: Add hyperlinks for the types as well. - (let ((print-quoted nil)) - (if (length> (nth 0 info) 0) - (insert (format "%s%S" (nth 0 info) (nth 1 info))) - ;; Make the non-":extra" bits look more like `C-h f' - ;; output. - (insert (format "%S" (cons function (nth 1 info)))))) + (let ((print-quoted nil) + (quals (if (length> qualifiers 0) + (concat (substring qualifiers + 0 (string-match " *\\'" + qualifiers)) + "\n") + ""))) + (insert (format "%s%S" + quals + (cons function + (cl--generic-upcase-formal-args args))))) (let* ((met-name (cl--generic-load-hist-format function (cl--generic-method-qualifiers method) @@ -1113,7 +1132,7 @@ MET-NAME is as returned by `cl--generic-load-hist-format'." 'help-function-def met-name file 'cl-defmethod) (insert (substitute-command-keys "'.\n")))) - (insert "\n" (or (nth 2 info) "Undocumented") "\n\n"))))))) + (insert "\n" (or doc "Undocumented") "\n\n"))))))) (defun cl--generic-specializers-apply-to-type-p (specializers type) "Return non-nil if a method with SPECIALIZERS applies to TYPE." diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el index 4e60a3c63d0..3f40ab07605 100644 --- a/lisp/emacs-lisp/cl-lib.el +++ b/lisp/emacs-lisp/cl-lib.el @@ -114,7 +114,10 @@ a future Emacs interpreter will be able to use it.") (defmacro cl-incf (place &optional x) "Increment PLACE by X (1 by default). PLACE may be a symbol, or any generalized variable allowed by `setf'. -The return value is the incremented value of PLACE." +The return value is the incremented value of PLACE. + +If X is specified, it should be an expression that should +evaluate to a number." (declare (debug (place &optional form))) (if (symbolp place) (list 'setq place (if x (list '+ place x) (list '1+ place))) @@ -123,7 +126,10 @@ The return value is the incremented value of PLACE." (defmacro cl-decf (place &optional x) "Decrement PLACE by X (1 by default). PLACE may be a symbol, or any generalized variable allowed by `setf'. -The return value is the decremented value of PLACE." +The return value is the decremented value of PLACE. + +If X is specified, it should be an expression that should +evaluate to a number." (declare (debug cl-incf)) (if (symbolp place) (list 'setq place (if x (list '- place x) (list '1- place))) diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 364b5120a0a..a9d422929f1 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -2560,7 +2560,7 @@ values. For compatibility, (cl-values A B C) is a synonym for (list A B C). (push x defun-declarations-alist))) (defun cl--optimize (f _args &rest qualities) - "Serve 'cl-optimize' in function declarations. + "Serve `cl-optimize' in function declarations. Example: (defun foo (x) (declare (cl-optimize (speed 3) (safety 0))) @@ -3403,9 +3403,11 @@ Of course, we really can't know that for sure, so it's just a heuristic." (boolean . booleanp) (bool-vector . bool-vector-p) (buffer . bufferp) + (byte-code-function . byte-code-function-p) (character . natnump) (char-table . char-table-p) (command . commandp) + (compiled-function . byte-code-function-p) (hash-table . hash-table-p) (cons . consp) (fixnum . fixnump) @@ -3419,6 +3421,7 @@ Of course, we really can't know that for sure, so it's just a heuristic." (null . null) (real . numberp) (sequence . sequencep) + (subr . subrp) (string . stringp) (symbol . symbolp) (vector . vectorp) diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index 93713f506d2..2b32bc4844a 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -53,13 +53,23 @@ (defconst cl--typeof-types ;; Hand made from the source code of `type-of'. '((integer number number-or-marker atom) - (symbol atom) (string array sequence atom) + (symbol-with-pos symbol atom) (symbol atom) (string array sequence atom) (cons list sequence) ;; Markers aren't `numberp', yet they are accepted wherever integers are ;; accepted, pretty much. (marker number-or-marker atom) (overlay atom) (float number atom) (window-configuration atom) - (process atom) (window atom) (subr atom) (compiled-function function atom) + (process atom) (window atom) + ;; FIXME: We'd want to put `function' here, but that's only true + ;; for those `subr's which aren't special forms! + (subr atom) + ;; FIXME: We should probably reverse the order between + ;; `compiled-function' and `byte-code-function' since arguably + ;; `subr' and also "compiled functions" but not "byte code functions", + ;; but it would require changing the value returned by `type-of' for + ;; byte code objects, which risks breaking existing code, which doesn't + ;; seem worth the trouble. + (compiled-function byte-code-function function atom) (module-function function atom) (buffer atom) (char-table array sequence atom) (bool-vector array sequence atom) diff --git a/lisp/emacs-lisp/cl-print.el b/lisp/emacs-lisp/cl-print.el index 2aade140e25..30d7e6525a4 100644 --- a/lisp/emacs-lisp/cl-print.el +++ b/lisp/emacs-lisp/cl-print.el @@ -221,26 +221,11 @@ into a button whose action shows the function's disassembly.") 'byte-code-function object))))) (princ ")" stream)) -;; This belongs in nadvice.el, of course, but some load-ordering issues make it -;; complicated: cl-generic uses macros from cl-macs and cl-macs uses advice-add -;; from nadvice, so nadvice needs to be loaded before cl-generic and hence -;; can't use cl-defmethod. -(cl-defmethod cl-print-object :extra "nadvice" - ((object compiled-function) stream) - (if (not (advice--p object)) - (cl-call-next-method) - (princ "#f(advice-wrapper " stream) - (when (fboundp 'advice--where) - (princ (advice--where object) stream) - (princ " " stream)) - (cl-print-object (advice--cdr object) stream) - (princ " " stream) - (cl-print-object (advice--car object) stream) - (let ((props (advice--props object))) - (when props - (princ " " stream) - (cl-print-object props stream))) - (princ ")" stream))) +;; This belongs in oclosure.el, of course, but some load-ordering issues make it +;; complicated. +(cl-defmethod cl-print-object ((object accessor) stream) + ;; FIXME: η-reduce! + (oclosure--accessor-cl-print object stream)) (cl-defmethod cl-print-object ((object cl-structure-object) stream) (if (and cl-print--depth (natnump print-level) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 00efedd71f3..237de52884b 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -238,7 +238,7 @@ native compilation runs.") (defvar comp-curr-allocation-class 'd-default "Current allocation class. -Can be one of: 'd-default', 'd-impure' or 'd-ephemeral'. See `comp-ctxt'.") +Can be one of: `d-default', `d-impure' or `d-ephemeral'. See `comp-ctxt'.") (defconst comp-passes '(comp-spill-lap comp-limplify @@ -1023,7 +1023,7 @@ To be used by all entry points." (defun comp-alloc-class-to-container (alloc-class) "Given ALLOC-CLASS, return the data container for the current context. -Assume allocation class 'd-default as default." +Assume allocation class `d-default' as default." (cl-struct-slot-value 'comp-ctxt (or alloc-class 'd-default) comp-ctxt)) (defsubst comp-add-const-to-relocs (obj) @@ -2633,8 +2633,8 @@ TARGET-BB-SYM is the symbol name of the target block." do (comp-emit-call-cstr target insn-cell cstr))))))) (defun comp-add-cstrs (_) - "Rewrite conditional branches adding appropriate 'assume' insns. -This is introducing and placing 'assume' insns in use by fwprop + "Rewrite conditional branches adding appropriate `assume' insns. +This is introducing and placing `assume' insns in use by fwprop to propagate conditional branch test information on target basic blocks." (maphash (lambda (_ f) @@ -3482,7 +3482,7 @@ Return the list of m-var ids nuked." (defun comp-remove-type-hints-func () "Remove type hints from the current function. -These are substituted with a normal 'set' op." +These are substituted with a normal `set' op." (cl-loop for b being each hash-value of (comp-func-blocks comp-func) do (comp-loop-insn-in-block b @@ -4217,7 +4217,7 @@ Generate .elc files in addition to the .eln files. Force the produced .eln to be outputted in the eln system directory (the last entry in `native-comp-eln-load-path') unless `native-compile-target-directory' is non-nil. If the environment -variable 'NATIVE_DISABLED' is set, only byte compile." +variable \"NATIVE_DISABLED\" is set, only byte compile." (comp-ensure-native-compiler) (if (equal (getenv "NATIVE_DISABLED") "1") (batch-byte-compile) diff --git a/lisp/emacs-lisp/crm.el b/lisp/emacs-lisp/crm.el index f3e1981732c..8a5c3d3730c 100644 --- a/lisp/emacs-lisp/crm.el +++ b/lisp/emacs-lisp/crm.el @@ -254,6 +254,23 @@ with empty strings removed." 'crm--choose-completion-string nil 'local) (setq-local minibuffer-completion-table #'crm--collection-fn) (setq-local minibuffer-completion-predicate predicate) + (setq-local completion-list-insert-choice-function + (lambda (start end choice) + (if (and (stringp start) (stringp end)) + (let* ((beg (save-excursion + (goto-char (minibuffer-prompt-end)) + (or (search-forward start nil t) + (search-forward-regexp crm-separator nil t) + (minibuffer-prompt-end)))) + (end (save-excursion + (goto-char (point-max)) + (or (search-backward end nil t) + (progn + (goto-char beg) + (search-forward-regexp crm-separator nil t)) + (point-max))))) + (completion--replace beg end choice)) + (completion--replace start end choice)))) ;; see completing_read in src/minibuf.c (setq-local minibuffer-completion-confirm (unless (eq require-match t) require-match)) diff --git a/lisp/emacs-lisp/debug-early.el b/lisp/emacs-lisp/debug-early.el index 85ed5f2176c..4f1f4b81557 100644 --- a/lisp/emacs-lisp/debug-early.el +++ b/lisp/emacs-lisp/debug-early.el @@ -35,30 +35,34 @@ (defalias 'debug-early-backtrace #'(lambda () - "Print a trace of Lisp function calls currently active. + "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")))))) + (princ "\n") + (let ((print-escape-newlines t) + (print-escape-control-characters t) + (print-escape-nonascii t) + (prin1 (if (fboundp 'cl-prin1) #'cl-prin1 #'prin1))) + (mapbacktrace + #'(lambda (evald func args _flags) + (let ((args args)) + (if evald + (progn + (princ " ") + (funcall prin1 func) + (princ "(")) + (progn + (princ " (") + (setq args (cons func args)))) + (if args + (while (progn + (funcall prin1 (car args)) + (setq args (cdr args))) + (princ " "))) + (princ ")\n"))))))) (defalias 'debug-early #'(lambda (&rest args) @@ -76,7 +80,7 @@ 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 +\(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. diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el index 46b0306d64f..6c172d6c31d 100644 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el @@ -90,6 +90,11 @@ The value used here is passed to `quit-restore-window'." :group 'debugger :version "24.3") +(defcustom debug-allow-recursive-debug nil + "If non-nil, erroring in debug and edebug won't recursively debug." + :type 'boolean + :version "29.1") + (defvar debugger-step-after-exit nil "Non-nil means \"single-step\" after the debugger exits.") @@ -534,11 +539,23 @@ The environment used is the one when entering the activation frame at point." (error 0)))) ;; If on first line. (base (debugger--backtrace-base))) (debugger-env-macro - (let ((val (backtrace-eval exp nframe base))) - (prog1 - (debugger--print val t) - (let ((str (eval-expression-print-format val))) - (if str (princ str t)))))))) + (let* ((errored nil) + (val (if debug-allow-recursive-debug + (backtrace-eval exp nframe base) + (condition-case err + (backtrace-eval exp nframe base) + (error (setq errored + (format "%s: %s" + (get (car err) 'error-message) + (car (cdr err))))))))) + (if errored + (progn + (message "Error: %s" errored) + nil) + (prog1 + (debugger--print val t) + (let ((str (eval-expression-print-format val))) + (if str (princ str t))))))))) (define-obsolete-function-alias 'debugger-toggle-locals 'backtrace-toggle-locals "28.1") diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 722283b88ff..d8b0a13c305 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -57,6 +57,7 @@ (require 'cl-lib) (require 'seq) (eval-when-compile (require 'pcase)) +(require 'debug) ;;; Options @@ -3711,12 +3712,25 @@ Return the result of the last expression." If interactive, prompt for the expression. Print result in minibuffer." (interactive (list (read--expression "Eval: "))) - (princ - (edebug-outside-excursion - (let ((result (edebug-eval expr))) - (values--store-value result) - (concat (edebug-safe-prin1-to-string result) - (eval-expression-print-format result)))))) + (let* ((errored nil) + (result + (edebug-outside-excursion + (let ((result (if debug-allow-recursive-debug + (edebug-eval expr) + (condition-case err + (edebug-eval expr) + (error + (setq errored + (format "%s: %s" + (get (car err) 'error-message) + (car (cdr err))))))))) + (unless errored + (values--store-value result) + (concat (edebug-safe-prin1-to-string result) + (eval-expression-print-format result))))))) + (if errored + (message "Error: %s" errored) + (princ result)))) (defun edebug-eval-last-sexp (&optional no-truncate) "Evaluate sexp before point in the outside environment. diff --git a/lisp/emacs-lisp/faceup.el b/lisp/emacs-lisp/faceup.el index 77689f434c2..b44132dcead 100644 --- a/lisp/emacs-lisp/faceup.el +++ b/lisp/emacs-lisp/faceup.el @@ -1006,7 +1006,7 @@ which could be defined as: (defun my-test-explain (args...) (let ((faceup-test-explain t)) (the-test args...))) - (put 'my-test 'ert-explainer 'my-test-explain) + (put \\='my-test \\='ert-explainer \\='my-test-explain) Alternative, you can use the macro `faceup-defexplainer' as follows: diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 7df40e36f8f..e7c3a4b64f5 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -1436,29 +1436,49 @@ and initial semicolons." (derived-mode-p 'emacs-lisp-mode)) emacs-lisp-docstring-fill-column fill-column))) - (save-restriction + (let ((ppss (syntax-ppss)) + (start (point))) (save-excursion - (let ((ppss (syntax-ppss)) - (start (point))) - ;; If we're in a string, then narrow (roughly) to that - ;; string before filling. This avoids filling Lisp - ;; statements that follow the string. - (when (ppss-string-terminator ppss) - (goto-char (ppss-comment-or-string-start ppss)) - (beginning-of-line) - ;; The string may be unterminated -- in that case, don't - ;; narrow. - (when (ignore-errors - (progn - (forward-sexp 1) - t)) - (narrow-to-region (ppss-comment-or-string-start ppss) - (point)))) - ;; Move back to where we were. + (save-restriction + ;; If we're not inside a string, then do very basic + ;; filling. This avoids corrupting embedded strings in + ;; code. + (if (not (ppss-comment-or-string-start ppss)) + (lisp--fill-line-simple) + ;; If we're in a string, then narrow (roughly) to that + ;; string before filling. This avoids filling Lisp + ;; statements that follow the string. + (when (ppss-string-terminator ppss) + (goto-char (ppss-comment-or-string-start ppss)) + ;; The string may be unterminated -- in that case, don't + ;; narrow. + (when (ignore-errors + (progn + (forward-sexp 1) + t)) + (narrow-to-region (ppss-comment-or-string-start ppss) + (point)))) + ;; Move back to where we were. + (goto-char start) + (fill-paragraph justify))))))) + ;; Never return nil. + t) + +(defun lisp--fill-line-simple () + (narrow-to-region (line-beginning-position) (line-end-position)) + (goto-char (point-min)) + (while (and (not (eobp)) + (re-search-forward "\\_>" nil t)) + (when (> (current-column) fill-column) + (let ((start (point))) + (backward-sexp) + (if (looking-back "[[(]" (point-min)) (goto-char start) - (fill-paragraph justify))))) - ;; Never return nil. - t)) + (skip-chars-backward " \t") + (insert "\n") + (forward-sexp)))) + (unless (eobp) + (forward-char 1)))) (defun indent-code-rigidly (start end arg &optional nochange-regexp) "Indent all lines of code, starting in the region, sideways by ARG columns. diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index e4bc2df2803..51c6e8e0ca2 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -330,108 +330,109 @@ Assumes the caller has bound `macroexpand-all-environment'." (setq form (macroexp-macroexpand form macroexpand-all-environment)) ;; FIXME: It'd be nice to use `byte-optimize--pcase' here, but when ;; I tried it, it broke the bootstrap :-( - (pcase form - (`(cond . ,clauses) - (macroexp--cons 'cond (macroexp--all-clauses clauses) form)) - (`(condition-case . ,(or `(,err ,body . ,handlers) pcase--dontcare)) - (macroexp--cons - 'condition-case - (macroexp--cons err - (macroexp--cons (macroexp--expand-all body) - (macroexp--all-clauses handlers 1) - (cddr form)) - (cdr form)) - form)) - (`(,(or 'defvar 'defconst) ,(and name (pred symbolp)) . ,_) - (push name macroexp--dynvars) - (macroexp--all-forms form 2)) - (`(function ,(and f `(lambda . ,_))) - (let ((macroexp--dynvars macroexp--dynvars)) - (macroexp--cons 'function - (macroexp--cons (macroexp--all-forms f 2) - nil - (cdr form)) - form))) - (`(,(or 'function 'quote) . ,_) form) - (`(,(and fun (or 'let 'let*)) . ,(or `(,bindings . ,body) - pcase--dontcare)) - (let ((macroexp--dynvars macroexp--dynvars)) + (let ((fn (car-safe form))) + (pcase form + (`(cond . ,clauses) + (macroexp--cons fn (macroexp--all-clauses clauses) form)) + (`(condition-case . ,(or `(,err ,body . ,handlers) pcase--dontcare)) (macroexp--cons - fun - (macroexp--cons - (macroexp--all-clauses bindings 1) - (if (null body) - (macroexp-unprogn - (macroexp-warn-and-return - (format "Empty %s body" fun) - nil nil 'compile-only fun)) - (macroexp--all-forms body)) - (cdr form)) - form))) - (`(,(and fun `(lambda . ,_)) . ,args) - ;; Embedded lambda in function position. - ;; If the byte-optimizer is loaded, try to unfold this, - ;; i.e. rewrite it to (let (<args>) <body>). We'd do it in the optimizer - ;; anyway, but doing it here (i.e. earlier) can sometimes avoid the - ;; creation of a closure, thus resulting in much better code. - (let ((newform (macroexp--unfold-lambda form))) - (if (eq newform form) - ;; Unfolding failed for some reason, avoid infinite recursion. - (macroexp--cons (macroexp--all-forms fun 2) - (macroexp--all-forms args) - form) - (macroexp--expand-all newform)))) - (`(funcall ,exp . ,args) - (let ((eexp (macroexp--expand-all exp)) - (eargs (macroexp--all-forms args))) - ;; Rewrite (funcall #'foo bar) to (foo bar), in case `foo' - ;; has a compiler-macro, or to unfold it. - (pcase eexp - ((and `#',f - (guard (not (or (special-form-p f) (macrop f))))) ;; bug#46636 - (macroexp--expand-all `(,f . ,eargs))) - (_ `(funcall ,eexp . ,eargs))))) - (`(funcall . ,_) form) ;bug#53227 - (`(,func . ,_) - (let ((handler (function-get func 'compiler-macro)) - (funargs (function-get func 'funarg-positions))) - ;; Check functions quoted with ' rather than with #' - (dolist (funarg funargs) - (let ((arg (nth funarg form))) - (when (and (eq 'quote (car-safe arg)) - (eq 'lambda (car-safe (cadr arg)))) - (setcar (nthcdr funarg form) - (macroexp-warn-and-return - (format "%S quoted with ' rather than with #'" - (let ((f (cadr arg))) - (if (symbolp f) f `(lambda ,(nth 1 f) ...)))) - 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. - (if (null handler) - ;; No compiler macro. We just expand each argument (for - ;; setq/setq-default this works alright because the variable names - ;; are symbols). - (macroexp--all-forms form 1) - ;; If the handler is not loaded yet, try (auto)loading the - ;; function itself, which may in turn load the handler. - (unless (functionp handler) - (with-demoted-errors "macroexp--expand-all: %S" - (autoload-do-load (indirect-function func) func))) - (let ((newform (macroexp--compiler-macro handler form))) - (if (eq form newform) - ;; The compiler macro did not find anything to do. - (if (equal form (setq newform (macroexp--all-forms form 1))) - form - ;; Maybe after processing the args, some new opportunities - ;; appeared, so let's try the compiler macro again. - (setq form (macroexp--compiler-macro handler newform)) - (if (eq newform form) - newform - (macroexp--expand-all newform))) - (macroexp--expand-all newform)))))) - (_ form))) + fn + (macroexp--cons err + (macroexp--cons (macroexp--expand-all body) + (macroexp--all-clauses handlers 1) + (cddr form)) + (cdr form)) + form)) + (`(,(or 'defvar 'defconst) ,(and name (pred symbolp)) . ,_) + (push name macroexp--dynvars) + (macroexp--all-forms form 2)) + (`(function ,(and f `(lambda . ,_))) + (let ((macroexp--dynvars macroexp--dynvars)) + (macroexp--cons fn + (macroexp--cons (macroexp--all-forms f 2) + nil + (cdr form)) + form))) + (`(,(or 'function 'quote) . ,_) form) + (`(,(and fun (or 'let 'let*)) . ,(or `(,bindings . ,body) + pcase--dontcare)) + (let ((macroexp--dynvars macroexp--dynvars)) + (macroexp--cons + fun + (macroexp--cons + (macroexp--all-clauses bindings 1) + (if (null body) + (macroexp-unprogn + (macroexp-warn-and-return + (format "Empty %s body" fun) + nil nil 'compile-only fun)) + (macroexp--all-forms body)) + (cdr form)) + form))) + (`(,(and fun `(lambda . ,_)) . ,args) + ;; Embedded lambda in function position. + ;; If the byte-optimizer is loaded, try to unfold this, + ;; i.e. rewrite it to (let (<args>) <body>). We'd do it in the optimizer + ;; anyway, but doing it here (i.e. earlier) can sometimes avoid the + ;; creation of a closure, thus resulting in much better code. + (let ((newform (macroexp--unfold-lambda form))) + (if (eq newform form) + ;; Unfolding failed for some reason, avoid infinite recursion. + (macroexp--cons (macroexp--all-forms fun 2) + (macroexp--all-forms args) + form) + (macroexp--expand-all newform)))) + (`(funcall ,exp . ,args) + (let ((eexp (macroexp--expand-all exp)) + (eargs (macroexp--all-forms args))) + ;; Rewrite (funcall #'foo bar) to (foo bar), in case `foo' + ;; has a compiler-macro, or to unfold it. + (pcase eexp + ((and `#',f + (guard (not (or (special-form-p f) (macrop f))))) ;; bug#46636 + (macroexp--expand-all `(,f . ,eargs))) + (_ `(funcall ,eexp . ,eargs))))) + (`(funcall . ,_) form) ;bug#53227 + (`(,func . ,_) + (let ((handler (function-get func 'compiler-macro)) + (funargs (function-get func 'funarg-positions))) + ;; Check functions quoted with ' rather than with #' + (dolist (funarg funargs) + (let ((arg (nth funarg form))) + (when (and (eq 'quote (car-safe arg)) + (eq 'lambda (car-safe (cadr arg)))) + (setcar (nthcdr funarg form) + (macroexp-warn-and-return + (format "%S quoted with ' rather than with #'" + (let ((f (cadr arg))) + (if (symbolp f) f `(lambda ,(nth 1 f) ...)))) + 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. + (if (null handler) + ;; No compiler macro. We just expand each argument (for + ;; setq/setq-default this works alright because the variable names + ;; are symbols). + (macroexp--all-forms form 1) + ;; If the handler is not loaded yet, try (auto)loading the + ;; function itself, which may in turn load the handler. + (unless (functionp handler) + (with-demoted-errors "macroexp--expand-all: %S" + (autoload-do-load (indirect-function func) func))) + (let ((newform (macroexp--compiler-macro handler form))) + (if (eq form newform) + ;; The compiler macro did not find anything to do. + (if (equal form (setq newform (macroexp--all-forms form 1))) + form + ;; Maybe after processing the args, some new opportunities + ;; appeared, so let's try the compiler macro again. + (setq form (macroexp--compiler-macro handler newform)) + (if (eq newform form) + newform + (macroexp--expand-all newform))) + (macroexp--expand-all newform)))))) + (_ form)))) (pop byte-compile-form-stack))) ;; Record which arguments expect functions, so we can warn when those diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el index dea5b34991a..8c67d7c7a25 100644 --- a/lisp/emacs-lisp/map.el +++ b/lisp/emacs-lisp/map.el @@ -175,7 +175,17 @@ MAP can be an alist, plist, hash-table, or array." (cl-defgeneric map-delete (map key) "Delete KEY in-place from MAP and return MAP. -Keys not present in MAP are ignored.") +Keys not present in MAP are ignored. + +Note that if MAP is a list (either alist or plist), and you're +deleting the final element in the list, the list isn't actually +destructively modified (but the return value will reflect the +deletion). So if you're using this method on a list, you have to +say + + (setq map (map-delete map key)) + +for this to work reliably.") (cl-defmethod map-delete ((map list) key) ;; FIXME: Signal map-not-inplace i.s.o returning a different list? @@ -540,7 +550,7 @@ TYPE is a list whose car is `hash-table' and cdr a list of keyword-args forwarded to `make-hash-table'. Example: - (map-into '((1 . 3)) '(hash-table :test eql))" + (map-into \\='((1 . 3)) \\='(hash-table :test eql))" (map--into-hash map (cdr type))) (defun map--make-pcase-bindings (args) diff --git a/lisp/emacs-lisp/nadvice.el b/lisp/emacs-lisp/nadvice.el index 77e140dda19..00c9e5438b8 100644 --- a/lisp/emacs-lisp/nadvice.el +++ b/lisp/emacs-lisp/nadvice.el @@ -42,55 +42,61 @@ ;; as this one), so we have to do it by hand! (push (purecopy '(nadvice 1 0)) package--builtin-versions) +(oclosure-define (advice + (:predicate advice--p) + (:copier advice--cons (cdr)) + (:copier advice--copy (car cdr how props))) + car cdr how props) + +(eval-when-compile + (defmacro advice--make-how-alist (&rest args) + `(list + ,@(mapcar + (lambda (arg) + (pcase-let ((`(,how . ,body) arg)) + `(list ,how + (oclosure-lambda (advice (how ,how)) (&rest r) + ,@body) + ,(replace-regexp-in-string + "\\<car\\>" "FUNCTION" + (replace-regexp-in-string + "\\<cdr\\>" "OLDFUN" + (format "%S" `(lambda (&rest r) ,@body)) + t t) + t t)))) + args)))) + ;;;; Lightweight advice/hook -(defvar advice--where-alist - '((:around "\300\301\302\003#\207" 5) - (:before "\300\301\002\"\210\300\302\002\"\207" 4) - (:after "\300\302\002\"\300\301\003\"\210\207" 5) - (:override "\300\301\002\"\207" 4) - (:after-until "\300\302\002\"\206\013\000\300\301\002\"\207" 4) - (:after-while "\300\302\002\"\205\013\000\300\301\002\"\207" 4) - (:before-until "\300\301\002\"\206\013\000\300\302\002\"\207" 4) - (:before-while "\300\301\002\"\205\013\000\300\302\002\"\207" 4) - (:filter-args "\300\302\301\003!\"\207" 5) - (:filter-return "\301\300\302\003\"!\207" 5)) +(defvar advice--how-alist + (advice--make-how-alist + (:around (apply car cdr r)) + (:before (apply car r) (apply cdr r)) + (:after (prog1 (apply cdr r) (apply car r))) + (:override (apply car r)) + (:after-until (or (apply cdr r) (apply car r))) + (:after-while (and (apply cdr r) (apply car r))) + (:before-until (or (apply car r) (apply cdr r))) + (:before-while (and (apply car r) (apply cdr r))) + (:filter-args (apply cdr (funcall car r))) + (:filter-return (funcall car (apply cdr r)))) "List of descriptions of how to add a function. -Each element has the form (WHERE BYTECODE STACK) where: - WHERE is a keyword indicating where the function is added. - BYTECODE is the corresponding byte-code that will be used. - STACK is the amount of stack space needed by the byte-code.") - -(defvar advice--bytecodes (mapcar #'cadr advice--where-alist)) - -(defun advice--p (object) - (and (byte-code-function-p object) - (eq 128 (aref object 0)) - (memq (length object) '(5 6)) - (memq (aref object 1) advice--bytecodes) - (eq #'apply (aref (aref object 2) 0)))) - -(defsubst advice--car (f) (aref (aref f 2) 1)) -(defsubst advice--cdr (f) (aref (aref f 2) 2)) -(defsubst advice--props (f) (aref (aref f 2) 3)) +Each element has the form (HOW OCL DOC) where HOW is a keyword, +OCL is a \"prototype\" function of type `advice', and +DOC is a string where \"FUNCTION\" and \"OLDFUN\" are expected.") (defun advice--cd*r (f) (while (advice--p f) (setq f (advice--cdr f))) f) -(defun advice--where (f) - (let ((bytecode (aref f 1)) - (where nil)) - (dolist (elem advice--where-alist) - (if (eq bytecode (cadr elem)) (setq where (car elem)))) - where)) +(define-obsolete-function-alias 'advice--where #'advice--how "29.1") (defun advice--make-single-doc (flist function macrop) - (let ((where (advice--where flist))) + (let ((how (advice--how flist))) (concat (format "This %s has %s advice: " (if macrop "macro" "function") - where) + how) (let ((fun (advice--car flist))) (if (symbolp fun) (format-message "`%S'." fun) (let* ((name (cdr (assq 'name (advice--props flist)))) @@ -180,33 +186,41 @@ Each element has the form (WHERE BYTECODE STACK) where: `(funcall ',fspec ',(cadr ifm)) (cadr (or iff ifm))))) -(defun advice--make-1 (byte-code stack-depth function main props) - "Build a function value that adds FUNCTION to MAIN." - (let ((adv-sig (gethash main advertised-signature-table)) - (advice - (apply #'make-byte-code 128 byte-code - (vector #'apply function main props) stack-depth nil - (and (or (commandp function) (commandp main)) - (list (advice--make-interactive-form - function main)))))) - (when adv-sig (puthash advice adv-sig advertised-signature-table)) - advice)) - -(defun advice--make (where function main props) - "Build a function value that adds FUNCTION to MAIN at WHERE. -WHERE is a symbol to select an entry in `advice--where-alist'." + +(cl-defmethod oclosure-interactive-form ((ad advice) &optional _) + (let ((car (advice--car ad)) + (cdr (advice--cdr ad))) + (when (or (commandp car) (commandp cdr)) + `(interactive ,(advice--make-interactive-form car cdr))))) + +(cl-defmethod cl-print-object ((object advice) stream) + (cl-assert (advice--p object)) + (princ "#f(advice " stream) + (cl-print-object (advice--car object) stream) + (princ " " stream) + (princ (advice--how object) stream) + (princ " " stream) + (cl-print-object (advice--cdr object) stream) + (let ((props (advice--props object))) + (when props + (princ " " stream) + (cl-print-object props stream))) + (princ ")" stream)) + +(defun advice--make (how function main props) + "Build a function value that adds FUNCTION to MAIN at HOW. +HOW is a symbol to select an entry in `advice--how-alist'." (let ((fd (or (cdr (assq 'depth props)) 0)) (md (if (advice--p main) (or (cdr (assq 'depth (advice--props main))) 0)))) (if (and md (> fd md)) ;; `function' should go deeper. - (let ((rest (advice--make where function (advice--cdr main) props))) - (advice--make-1 (aref main 1) (aref main 3) - (advice--car main) rest (advice--props main))) - (let ((desc (assq where advice--where-alist))) - (unless desc (error "Unknown add-function location `%S'" where)) - (advice--make-1 (nth 1 desc) (nth 2 desc) - function main props))))) + (let ((rest (advice--make how function (advice--cdr main) props))) + (advice--cons main rest)) + (let ((proto (assq how advice--how-alist))) + (unless proto (error "Unknown add-function location `%S'" how)) + (advice--copy (cadr proto) + function main how props))))) (defun advice--member-p (function use-name definition) (let ((found nil)) @@ -232,8 +246,7 @@ WHERE is a symbol to select an entry in `advice--where-alist'." (if val (car val) (let ((nrest (advice--tweak rest tweaker))) (if (eq rest nrest) flist - (advice--make-1 (aref flist 1) (aref flist 3) - first nrest props)))))))) + (advice--cons flist nrest)))))))) ;;;###autoload (defun advice--remove-function (flist function) @@ -273,10 +286,33 @@ different, but `function-equal' will hopefully ignore those differences.") ((symbolp place) `(default-value ',place)) (t place)))) +(defun nadvice--make-docstring (sym) + (let* ((main (documentation (symbol-function sym) 'raw)) + (ud (help-split-fundoc main 'pcase)) + (doc (or (cdr ud) main)) + (col1width (apply #'max (mapcar (lambda (x) + (string-width (symbol-name (car x)))) + advice--how-alist))) + (table (mapconcat (lambda (x) + (format (format " %%-%ds %%s" col1width) + (car x) (nth 2 x))) + advice--how-alist "\n")) + (table (if global-prettify-symbols-mode + (replace-regexp-in-string "(lambda\\>" "(λ" table t t) + table)) + (combined-doc + (if (not (string-match "<<>>" doc)) + doc + (replace-match table t t doc)))) + (if ud (help-add-fundoc-usage combined-doc (car ud)) combined-doc))) + +(put 'add-function 'function-documentation + '(nadvice--make-docstring 'add-function)) + ;;;###autoload -(defmacro add-function (where place function &optional props) +(defmacro add-function (how place function &optional props) ;; TODO: - ;; - maybe let `where' specify some kind of predicate and use it + ;; - maybe let `how' specify some kind of predicate and use it ;; to implement things like mode-local or eieio-defmethod. ;; Of course, that only makes sense if the predicates of all advices can ;; be combined and made more efficient. @@ -285,20 +321,11 @@ different, but `function-equal' will hopefully ignore those differences.") ;; :before-until is like add-hook on run-hook-with-args-until-success. ;; Same with :after-* but for (add-hook ... 'append). "Add a piece of advice on the function stored at PLACE. -FUNCTION describes the code to add. WHERE describes where to add it. -WHERE can be explained by showing the resulting new function, as the +FUNCTION describes the code to add. HOW describes how to add it. +HOW can be explained by showing the resulting new function, as the result of combining FUNCTION and the previous value of PLACE, which we call OLDFUN here: -`:before' (lambda (&rest r) (apply FUNCTION r) (apply OLDFUN r)) -`:after' (lambda (&rest r) (prog1 (apply OLDFUN r) (apply FUNCTION r))) -`:around' (lambda (&rest r) (apply FUNCTION OLDFUN r)) -`:override' (lambda (&rest r) (apply FUNCTION r)) -`:before-while' (lambda (&rest r) (and (apply FUNCTION r) (apply OLDFUN r))) -`:before-until' (lambda (&rest r) (or (apply FUNCTION r) (apply OLDFUN r))) -`:after-while' (lambda (&rest r) (and (apply OLDFUN r) (apply FUNCTION r))) -`:after-until' (lambda (&rest r) (or (apply OLDFUN r) (apply FUNCTION r))) -`:filter-args' (lambda (&rest r) (apply OLDFUN (funcall FUNCTION r))) -`:filter-return'(lambda (&rest r) (funcall FUNCTION (apply OLDFUN r))) +<<>> If FUNCTION was already added, do nothing. PROPS is an alist of additional properties, among which the following have a special meaning: @@ -326,13 +353,13 @@ is also interactive. There are 3 cases: ;;(indent 2) (debug (form [&or symbolp ("local" form) ("var" sexp) gv-place] form &optional form))) - `(advice--add-function ,where (gv-ref ,(advice--normalize-place place)) + `(advice--add-function ,how (gv-ref ,(advice--normalize-place place)) ,function ,props)) (declare-function comp-subr-trampoline-install "comp") ;;;###autoload -(defun advice--add-function (where ref function props) +(defun advice--add-function (how ref function props) (when (and (featurep 'native-compile) (subr-primitive-p (gv-deref ref))) (let ((subr-name (intern (subr-name (gv-deref ref))))) @@ -357,7 +384,7 @@ is also interactive. There are 3 cases: (advice--remove-function (gv-deref ref) (or name (advice--car a))))) (setf (gv-deref ref) - (advice--make where function (gv-deref ref) props)))) + (advice--make how function (gv-deref ref) props)))) ;;;###autoload (defmacro remove-function (place function) @@ -455,11 +482,16 @@ of the piece of advice." (put symbol 'advice--pending (advice--subst-main oldadv nil))) (funcall fsetfun symbol newdef)))) +(put 'advice-add 'function-documentation + '(nadvice--make-docstring 'advice-add)) + ;;;###autoload -(defun advice-add (symbol where function &optional props) +(defun advice-add (symbol how function &optional props) "Like `add-function' but for the function named SYMBOL. Contrary to `add-function', this will properly handle the cases where SYMBOL -is defined as a macro, alias, command, ..." +is defined as a macro, alias, command, ... +HOW can be one of: +<<>>" ;; TODO: ;; - record the advice location, to display in describe-function. ;; - change all defadvice in lisp/**/*.el. @@ -467,21 +499,21 @@ is defined as a macro, alias, command, ..." (let* ((f (symbol-function symbol)) (nf (advice--normalize symbol f))) (unless (eq f nf) (fset symbol nf)) - (add-function where (cond - ((eq (car-safe nf) 'macro) (cdr nf)) - ;; Reasons to delay installation of the advice: - ;; - If the function is not yet defined, installing - ;; the advice would affect `fboundp'ness. - ;; - the symbol-function slot of an autoloaded - ;; function is not itself a function value. - ;; - `autoload' does nothing if the function is - ;; not an autoload or undefined. - ((or (not nf) (autoloadp nf)) - (get symbol 'advice--pending)) - (t (symbol-function symbol))) + (add-function how (cond + ((eq (car-safe nf) 'macro) (cdr nf)) + ;; Reasons to delay installation of the advice: + ;; - If the function is not yet defined, installing + ;; the advice would affect `fboundp'ness. + ;; - the symbol-function slot of an autoloaded + ;; function is not itself a function value. + ;; - `autoload' does nothing if the function is + ;; not an autoload or undefined. + ((or (not nf) (autoloadp nf)) + (get symbol 'advice--pending)) + (t (symbol-function symbol))) function props) - ;; FIXME: We could use a defmethod on `function-docstring' instead, - ;; except when (or (not nf) (autoloadp nf))! + ;; FIXME: We could use a defmethod on `function-documentation' instead, + ;; except when (autoloadp nf)! (put symbol 'function-documentation `(advice--make-docstring ',symbol)) (add-function :around (get symbol 'defalias-fset-function) #'advice--defalias-fset)) @@ -517,12 +549,12 @@ See `advice-add' and `add-function' for explanation on the arguments. Note if NAME is nil the advice is anonymous; otherwise it is named `SYMBOL@NAME'. -\(fn SYMBOL (WHERE LAMBDA-LIST &optional NAME DEPTH) &rest BODY)" +\(fn SYMBOL (HOW LAMBDA-LIST &optional NAME DEPTH) &rest BODY)" (declare (indent 2) (doc-string 3) (debug (sexp sexp def-body))) (or (listp args) (signal 'wrong-type-argument (list 'listp args))) (or (<= 2 (length args) 4) (signal 'wrong-number-of-arguments (list 2 4 (length args)))) - (let* ((where (nth 0 args)) + (let* ((how (nth 0 args)) (lambda-list (nth 1 args)) (name (nth 2 args)) (depth (nth 3 args)) @@ -532,7 +564,7 @@ otherwise it is named `SYMBOL@NAME'. (intern (format "%s@%s" symbol name))) (t (error "Unrecognized name spec `%S'" name))))) `(prog1 ,@(and (symbolp advice) `((defun ,advice ,lambda-list ,@body))) - (advice-add ',symbol ,where #',advice ,@(and props `(',props)))))) + (advice-add ',symbol ,how #',advice ,@(and props `(',props)))))) (defun advice-mapc (fun symbol) "Apply FUN to every advice function in SYMBOL. diff --git a/lisp/emacs-lisp/oclosure.el b/lisp/emacs-lisp/oclosure.el index 90811199f25..cb8c59b05a2 100644 --- a/lisp/emacs-lisp/oclosure.el +++ b/lisp/emacs-lisp/oclosure.el @@ -505,6 +505,13 @@ This has 2 uses: "OClosure function to access a specific slot of an object." type slot) +(defun oclosure--accessor-cl-print (object stream) + (princ "#f(accessor " stream) + (prin1 (accessor--type object) stream) + (princ "." stream) + (prin1 (accessor--slot object) stream) + (princ ")" stream)) + (defun oclosure--accessor-docstring (f) ;; This would like to be a (cl-defmethod function-documentation ...) ;; but for circularity reason the defmethod is in `simple.el'. diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index b42dc06c6c2..c699454b0bb 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -567,9 +567,9 @@ This is the name of the package with its version appended." "Return file-name extension of package-desc object PKG-DESC. Depending on the `package-desc-kind' of PKG-DESC, this is one of: - 'single - \".el\" - 'tar - \".tar\" - 'dir - \"\" + \\='single - \".el\" + \\='tar - \".tar\" + \\='dir - \"\" Signal an error if the kind is none of the above." (pcase (package-desc-kind pkg-desc) @@ -2137,6 +2137,31 @@ to install it but still mark it as selected." (message "Package `%s' installed." name)) (message "`%s' is already installed" name)))) +;;;###autoload +(defun package-update (name) + "Update package NAME if a newer version exists." + (interactive + (progn + ;; Initialize the package system to get the list of package + ;; symbols for completion. + (package--archives-initialize) + (list (completing-read + "Update package: " + (mapcar + #'car + (seq-filter + (lambda (elt) + (let ((available + (assq (car elt) package-archive-contents))) + (and available + (version-list-< + (package-desc-priority-version (cadr elt)) + (package-desc-priority-version (cadr available)))))) + package-alist)) + nil t)))) + (package-delete (cadr (assq (intern name) package-alist)) 'force) + (package-install (intern name) 'dont-select)) + (defun package-strip-rcs-id (str) "Strip RCS version ID from the version string STR. If the result looks like a dotted numeric version, return it. @@ -3466,7 +3491,7 @@ corresponding to the newer version." ;; ENTRY is (PKG-DESC [NAME VERSION STATUS DOC]) (let ((pkg-desc (car entry)) (status (aref (cadr entry) 2))) - (cond ((member status '("installed" "dependency" "unsigned")) + (cond ((member status '("installed" "dependency" "unsigned" "external")) (push pkg-desc installed)) ((member status '("available" "new")) (setq available (package--append-to-alist pkg-desc available)))))) diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 0330a2a0aba..07443dabfef 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -328,7 +328,7 @@ PATTERNS are normal `pcase' patterns, and VALUES are expression. Evaluation happens sequentially as in `setq' (not in parallel). -An example: (pcase-setq `((,a) [(,b)]) '((1) [(2)])) +An example: (pcase-setq \\=`((,a) [(,b)]) \\='((1) [(2)])) VAL is presumed to match PAT. Failure to match may signal an error or go undetected, binding variables to arbitrary values, such as nil. diff --git a/lisp/emacs-lisp/shadow.el b/lisp/emacs-lisp/shadow.el index 8cd371321ae..2343a9b589f 100644 --- a/lisp/emacs-lisp/shadow.el +++ b/lisp/emacs-lisp/shadow.el @@ -177,12 +177,11 @@ See the documentation for `list-load-path-shadows' for further information." . (1 font-lock-warning-face))) "Keywords to highlight in `load-path-shadows-mode'.") -(define-derived-mode load-path-shadows-mode fundamental-mode "LP-Shadows" +(define-derived-mode load-path-shadows-mode special-mode "LP-Shadows" "Major mode for `load-path' shadows buffer." (setq-local font-lock-defaults '((load-path-shadows-font-lock-keywords))) - (setq buffer-undo-list t - buffer-read-only t)) + (setq buffer-undo-list t)) ;; TODO use text-properties instead, a la dired. (define-button-type 'load-path-shadows-find-file diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index abf85ab6c67..9cd793d05c5 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -81,116 +81,6 @@ Note how the single `-' got converted into a list before threading." (declare (indent 0) (debug thread-first)) `(internal--thread-argument nil ,@forms)) - -(defsubst internal--listify (elt) - "Wrap ELT in a list if it is not one. -If ELT is of the form ((EXPR)), listify (EXPR) with a dummy symbol." - (cond - ((symbolp elt) (list elt elt)) - ((null (cdr elt)) - (list (make-symbol "s") (car elt))) - (t elt))) - -(defsubst internal--check-binding (binding) - "Check BINDING is properly formed." - (when (> (length binding) 2) - (signal - 'error - (cons "`let' bindings can have only one value-form" binding))) - binding) - -(defsubst internal--build-binding-value-form (binding prev-var) - "Build the conditional value form for BINDING using PREV-VAR." - (let ((var (car binding))) - `(,var (and ,prev-var ,(cadr binding))))) - -(defun internal--build-binding (binding prev-var) - "Check and build a single BINDING with PREV-VAR." - (thread-first - binding - internal--listify - internal--check-binding - (internal--build-binding-value-form prev-var))) - -(defun internal--build-bindings (bindings) - "Check and build conditional value forms for BINDINGS." - (let ((prev-var t)) - (mapcar (lambda (binding) - (let ((binding (internal--build-binding binding prev-var))) - (setq prev-var (car binding)) - binding)) - bindings))) - -(defmacro if-let* (varlist then &rest else) - "Bind variables according to VARLIST and evaluate THEN or ELSE. -This is like `if-let' but doesn't handle a VARLIST of the form -\(SYMBOL SOMETHING) specially." - (declare (indent 2) - (debug ((&rest [&or symbolp (symbolp form) (form)]) - body))) - (if varlist - `(let* ,(setq varlist (internal--build-bindings varlist)) - (if ,(caar (last varlist)) - ,then - ,@else)) - `(let* () ,then))) - -(defmacro when-let* (varlist &rest body) - "Bind variables according to VARLIST and conditionally evaluate BODY. -This is like `when-let' but doesn't handle a VARLIST of the form -\(SYMBOL SOMETHING) specially." - (declare (indent 1) (debug if-let*)) - (list 'if-let* varlist (macroexp-progn body))) - -(defmacro and-let* (varlist &rest body) - "Bind variables according to VARLIST and conditionally evaluate BODY. -Like `when-let*', except if BODY is empty and all the bindings -are non-nil, then the result is non-nil." - (declare (indent 1) (debug if-let*)) - (let (res) - (if varlist - `(let* ,(setq varlist (internal--build-bindings varlist)) - (when ,(setq res (caar (last varlist))) - ,@(or body `(,res)))) - `(let* () ,@(or body '(t)))))) - -;;;###autoload -(defmacro if-let (spec then &rest else) - "Bind variables according to SPEC and evaluate THEN or ELSE. -Evaluate each binding in turn, as in `let*', stopping if a -binding value is nil. If all are non-nil return the value of -THEN, otherwise the last form in ELSE. - -Each element of SPEC is a list (SYMBOL VALUEFORM) that binds -SYMBOL to the value of VALUEFORM. An element can additionally be -of the form (VALUEFORM), which is evaluated and checked for nil; -i.e. SYMBOL can be omitted if only the test result is of -interest. It can also be of the form SYMBOL, then the binding of -SYMBOL is checked for nil. - -As a special case, interprets a SPEC of the form \(SYMBOL SOMETHING) -like \((SYMBOL SOMETHING)). This exists for backward compatibility -with an old syntax that accepted only one binding." - (declare (indent 2) - (debug ([&or (symbolp form) ; must be first, Bug#48489 - (&rest [&or symbolp (symbolp form) (form)])] - body))) - (when (and (<= (length spec) 2) - (not (listp (car spec)))) - ;; Adjust the single binding case - (setq spec (list spec))) - (list 'if-let* spec then (macroexp-progn else))) - -;;;###autoload -(defmacro when-let (spec &rest body) - "Bind variables according to SPEC and conditionally evaluate BODY. -Evaluate each binding in turn, stopping if a binding value is nil. -If all are non-nil, return the value of the last form in BODY. - -The variable list SPEC is the same as in `if-let'." - (declare (indent 1) (debug if-let)) - (list 'if-let spec (macroexp-progn body))) - (defsubst hash-table-empty-p (hash-table) "Check whether HASH-TABLE is empty (has 0 elements)." (zerop (hash-table-count hash-table))) @@ -526,6 +416,43 @@ this defaults to the current buffer." (error "No process selected")) process))) +(defmacro with-buffer-unmodified-if-unchanged (&rest body) + "Like `progn', but change buffer-modified status only if buffer text changes. +If the buffer was unmodified before execution of BODY, and +buffer text after execution of BODY is identical to what it was +before, ensure that buffer is still marked unmodified afterwards. +For example, the following won't change the buffer's modification +status: + + (with-buffer-unmodified-if-unchanged + (insert \"a\") + (delete-char -1)) + +Note that only changes in the raw byte sequence of the buffer text, +as stored in the internal representation, are monitored for the +purpose of detecting the lack of changes in buffer text. Any other +changes that are normally perceived as \"buffer modifications\", such +as changes in text properties, `buffer-file-coding-system', buffer +multibyteness, etc. -- will not be noticed, and the buffer will still +be marked unmodified, effectively ignoring those changes." + (declare (debug t) (indent 0)) + (let ((hash (gensym)) + (buffer (gensym))) + `(let ((,hash (and (not (buffer-modified-p)) + (buffer-hash))) + (,buffer (current-buffer))) + (prog1 + (progn + ,@body) + ;; If we didn't change anything in the buffer (and the buffer + ;; was previously unmodified), then flip the modification status + ;; back to "unchanged". + (when (and ,hash (buffer-live-p ,buffer)) + (with-current-buffer ,buffer + (when (and (buffer-modified-p) + (equal ,hash (buffer-hash))) + (restore-buffer-modified-p nil)))))))) + (provide 'subr-x) ;;; subr-x.el ends here diff --git a/lisp/emacs-lisp/text-property-search.el b/lisp/emacs-lisp/text-property-search.el index 9f86a28eb64..d11980f4f45 100644 --- a/lisp/emacs-lisp/text-property-search.el +++ b/lisp/emacs-lisp/text-property-search.el @@ -47,7 +47,7 @@ match if is not `equal' to VALUE. Furthermore, a nil PREDICATE means that the match region is ended if the value changes. For instance, this means that if you loop with - (while (setq prop (text-property-search-forward 'face)) + (while (setq prop (text-property-search-forward \\='face)) ...) you will get all distinct regions with non-nil `face' values in @@ -166,7 +166,6 @@ and if a matching region is found, place point at the start of the region." (let ((origin (point)) (ended nil) pos) - (forward-char -1) ;; Find the previous candidate. (while (not ended) (setq pos (previous-single-property-change (point) property)) diff --git a/lisp/emacs-lisp/timer-list.el b/lisp/emacs-lisp/timer-list.el index c93a50cabfe..aef18d0ba27 100644 --- a/lisp/emacs-lisp/timer-list.el +++ b/lisp/emacs-lisp/timer-list.el @@ -62,7 +62,7 @@ ((numberp repeat) (propertize (format "%12s" (format-seconds - "%dd %hh %mm %z%,1ss" repeat)) + "%x%dd %hh %mm %z%,1ss" repeat)) 'help-echo "Repeat interval")) ((null repeat) (propertize " -" 'help-echo "Runs once")) diff --git a/lisp/emacs-lisp/vtable.el b/lisp/emacs-lisp/vtable.el index 8d777335315..61265c97c28 100644 --- a/lisp/emacs-lisp/vtable.el +++ b/lisp/emacs-lisp/vtable.el @@ -28,6 +28,12 @@ (require 'text-property-search) (require 'mule-util) +(defface vtable + '((t :inherit variable-pitch)) + "Face used (by default) for vtables." + :version "29.1" + :group 'faces) + (cl-defstruct vtable-column "A vtable column." name @@ -55,10 +61,16 @@ (actions :initarg :actions :accessor vtable-actions) (keymap :initarg :keymap :accessor vtable-keymap) (separator-width :initarg :separator-width :accessor vtable-separator-width) + (divider :initarg :divider :accessor vtable-divider :initform nil) (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.") + (column-colors :initarg :column-colors :accessor vtable-column-colors) + (row-colors :initarg :row-colors :accessor vtable-row-colors) + (-cached-colors :initform nil) + (-cache :initform (make-hash-table :test #'equal)) + (-cached-keymap :initform nil) + (-has-column-spec :initform nil)) + "An object to hold the data for a table.") (defvar-keymap vtable-map "S" #'vtable-sort-by-current-column @@ -78,53 +90,84 @@ formatter displayer (use-header-line t) - (face 'variable-pitch) + (face 'vtable) actions keymap (separator-width 1) + divider + divider-width sort-by (ellipsis t) - (insert t)) + (insert t) + row-colors + column-colors) "Create and insert a vtable at point. The vtable object is returned. If INSERT is nil, the table won't -be inserted." +be inserted. + +See info node `(vtable)Top' for vtable documentation." (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))) + (make-instance + 'vtable + :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 + :row-colors row-colors + :column-colors column-colors + :ellipsis ellipsis))) + ;; Store whether the user has specified columns or not. + (setf (slot-value table '-has-column-spec) (not (not columns))) + ;; Auto-generate the columns. + (unless columns + (unless objects + (error "Can't auto-generate columns; no objects")) + (setq columns (make-list (length (car objects)) ""))) + (setf (vtable-columns table) + (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)) ;; Compute missing column data. (setf (vtable-columns table) (vtable--compute-columns table)) + ;; Compute the colors. + (when (or row-colors column-colors) + (setf (slot-value table '-cached-colors) + (vtable--compute-colors row-colors column-colors))) + ;; Compute the divider. + (when (or divider divider-width) + (setf (vtable-divider table) + (propertize + (or (copy-sequence divider) + (propertize + " " 'display + (list 'space :width + (list (vtable--compute-width table divider-width))))) + 'mouse-face 'highlight + 'keymap + (define-keymap + "<drag-mouse-1>" #'vtable--drag-resize-column + "<down-mouse-1>" #'ignore)))) + ;; Compute the keymap. + (setf (slot-value table '-cached-keymap) (vtable--make-keymap table)) (unless sort-by (seq-do-indexed (lambda (column index) (when (vtable-column-primary column) @@ -135,6 +178,52 @@ be inserted." (vtable-insert table)) table)) +(defun vtable--compute-colors (row-colors column-colors) + (cond + ((null column-colors) + (mapcar #'vtable--make-color-face row-colors)) + ((null row-colors) + (mapcar #'vtable--make-color-face column-colors)) + (t + (cl-loop for row in row-colors + collect (cl-loop for column in column-colors + collect (vtable--face-blend + (vtable--make-color-face row) + (vtable--make-color-face column))))))) + +(defun vtable--make-color-face (object) + (if (stringp object) + (list :background object) + object)) + +(defun vtable--face-blend (face1 face2) + (let ((foreground (vtable--face-color face1 face2 #'face-foreground + :foreground)) + (background (vtable--face-color face1 face2 #'face-background + :background))) + `(,@(and foreground (list :foreground foreground)) + ,@(and background (list :background background))))) + +(defun vtable--face-color (face1 face2 accessor slot) + (let ((col1 (if (facep face1) + (funcall accessor face1) + (plist-get face1 slot))) + (col2 (if (facep face2) + (funcall accessor face2) + (plist-get face2 slot)))) + (if (and col1 col2) + (vtable--color-blend col1 col2) + (or col1 col2)))) + +;;; FIXME: This is probably not the right way to blend two colors, is +;;; it? +(defun vtable--color-blend (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))) + ;;; Interface utility functions. (defun vtable-current-table () @@ -210,7 +299,8 @@ If it can't be found, return nil and don't move point." (error "Can't find the old object")) (setcar (cdr objects) object)) ;; Then update the cache... - (let ((line (assq old-object (car (vtable--cache table))))) + (let* ((line-number (seq-position old-object (car (vtable--cache table)))) + (line (elt (car (vtable--cache table)) line-number))) (unless line (error "Can't find cached object")) (setcar line object) @@ -221,7 +311,8 @@ If it can't be found, return nil and don't move point." (let ((keymap (get-text-property (point) 'keymap)) (start (point))) (delete-line) - (vtable--insert-line table line (nth 1 (vtable--cache table)) + (vtable--insert-line table line line-number + (nth 1 (vtable--cache table)) (vtable--spacer table)) (add-text-properties start (point) (list 'keymap keymap 'vtable table)))) @@ -276,7 +367,10 @@ This also updates the displayed table." (unless (vtable-goto-object after-object) (vtable-end-of-table)))) (let ((start (point))) - (vtable--insert-line table line (nth 1 cache) (vtable--spacer table)) + ;; FIXME: We have to adjust colors in lines below this if we + ;; have :row-colors. + (vtable--insert-line table line 0 + (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 @@ -333,6 +427,16 @@ This also updates the displayed table." (defun vtable--spacer (table) (vtable--compute-width table (vtable-separator-width table))) +(defun vtable--recompute-cache (table) + (let* ((data (vtable--compute-cache table)) + (widths (vtable--compute-widths table data))) + (setf (gethash (vtable--cache-key) (slot-value table '-cache)) + (list data widths)))) + +(defun vtable--ensure-cache (table) + (or (vtable--cache table) + (vtable--recompute-cache table))) + (defun vtable-insert (table) (let* ((spacer (vtable--spacer table)) (start (point)) @@ -341,43 +445,48 @@ This also updates the displayed table." '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))) + ;; 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). + (widths (nth 1 (vtable--ensure-cache table)))) + ;; Don't insert any header or header line if the user hasn't + ;; specified the columns. + (when (slot-value table '-has-column-spec) + (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)) + (let ((line-number 0)) + (dolist (line (car (vtable--cache table))) + (vtable--insert-line table line line-number widths spacer + ellipsis ellipsis-width) + (setq line-number (1+ line-number)))) (add-text-properties start (point) - (list 'keymap (vtable--make-keymap table) - 'rear-nonsticky t + (list 'rear-nonsticky t 'vtable table)) (goto-char start))) -(defun vtable--insert-line (table line widths spacer +(defun vtable--insert-line (table line line-number widths spacer &optional ellipsis ellipsis-width) (let ((start (point)) - (columns (vtable-columns table))) + (columns (vtable-columns table)) + (column-colors + (and (vtable-column-colors table) + (if (vtable-row-colors table) + (elt (slot-value table '-cached-colors) + (mod line-number (length (vtable-row-colors table)))) + (slot-value table '-cached-colors)))) + (divider (vtable-divider table)) + (keymap (slot-value table '-cached-keymap))) (seq-do-indexed (lambda (elem index) (let ((value (nth 0 elem)) @@ -418,30 +527,47 @@ This also updates the displayed table." value (- (elt widths index) ellipsis-width)) ellipsis) value)))) - (start (point))) + (start (point)) + ;; Don't insert the separator after the final column. + (last (= index (- (length line) 2)))) (if (eq (vtable-column-align column) 'left) - (insert displayed - (propertize - " " 'display - (list 'space - :width (list - (+ (- (elt widths index) - (string-pixel-width displayed)) - spacer))))) + (progn + (insert displayed) + (insert (propertize + " " 'display + (list 'space + :width (list + (+ (- (elt widths index) + (string-pixel-width displayed)) + (if last 0 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)))) + displayed) + (unless last + (insert (propertize " " 'display + (list 'space + :width (list spacer)))))) + (put-text-property start (point) 'vtable-column index) + (put-text-property start (point) 'keymap keymap) + (when column-colors + (add-face-text-property + start (point) + (elt column-colors (mod index (length column-colors))))) + (when divider + (insert divider) + (setq start (point)))))) (cdr line)) (insert "\n") - (put-text-property start (point) 'vtable-object (car line)))) + (put-text-property start (point) 'vtable-object (car line)) + (unless column-colors + (when-let ((row-colors (slot-value table '-cached-colors))) + (add-face-text-property + start (point) + (elt row-colors (mod line-number (length row-colors)))))))) (defun vtable--cache-key () (cons (frame-terminal) (window-width))) @@ -493,35 +619,112 @@ This also updates the displayed table." (defun vtable--insert-header-line (table widths spacer) ;; Insert the header directly into the buffer. - (let* ((start (point))) + (let ((start (point)) + (divider (vtable-divider table)) + (cmap (define-keymap + "<header-line> <drag-mouse-1>" #'vtable--drag-resize-column + "<header-line> <down-mouse-1>" #'ignore)) + (dmap (define-keymap + "<header-line> <drag-mouse-1>" + (lambda (e) + (interactive "e") + (vtable--drag-resize-column e t)) + "<header-line> <down-mouse-1>" #'ignore))) (seq-do-indexed (lambda (column index) (let* ((name (propertize (vtable-column-name column) - 'face (list 'header-line (vtable-face table)))) + 'face (list 'header-line (vtable-face table)) + 'mouse-face 'header-line-highlight + 'keymap cmap)) (start (point)) (indicator (vtable--indicator table index)) (indicator-width (string-pixel-width indicator)) + (last (= index (1- (length (vtable-columns table))))) 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))))) + (setq displayed + (if (> (string-pixel-width name) + (- (elt widths index) indicator-width)) + (vtable--limit-string + name (- (elt widths index) indicator-width)) + name)) + (let ((fill-width + (+ (- (elt widths index) + (string-pixel-width displayed) + indicator-width + (vtable-separator-width table) + ;; We want the indicator to not be quite flush + ;; right. + (/ (vtable--char-width table) 2.0)) + (if last 0 spacer)))) + (if (or (not last) + (zerop indicator-width) + (< (seq-reduce #'+ widths 0) (window-width nil t))) + ;; Normal case. + (insert + displayed + (propertize " " 'display + (list 'space :width (list fill-width))) + indicator) + ;; This is the final column, and we have a sorting + ;; indicator, and the table is too wide for the window. + (let* ((pre-indicator (string-pixel-width + (buffer-substring (point-min) (point)))) + (pre-fill + (- (window-width nil t) + pre-indicator + (string-pixel-width displayed)))) + (insert + displayed + (propertize " " 'display + (list 'space :width (list pre-fill))) + indicator + (propertize " " 'display + (list 'space :width + (list (- fill-width pre-fill)))))))) + (when (and divider (not last)) + (insert (propertize divider 'keymap dmap))) + (insert (propertize + " " 'display + (list 'space :width (list + (/ (vtable--char-width table) 2.0))))) (put-text-property start (point) 'vtable-column index))) (vtable-columns table)) (insert "\n") (add-face-text-property start (point) 'header-line))) +(defun vtable--drag-resize-column (e &optional next) + "Resize the column by dragging. +If NEXT, do the next column." + (interactive "e") + (let* ((pos-start (event-start e)) + (obj (posn-object pos-start))) + (with-current-buffer (window-buffer (posn-window pos-start)) + (let ((column + ;; In the header line we have a text property on the + ;; divider. + (or (get-text-property (if obj (cdr obj) + (posn-point pos-start)) + 'vtable-column + (car obj)) + ;; For reasons of efficiency, we don't have that in + ;; the buffer itself, so find the column. + (save-excursion + (goto-char (posn-point pos-start)) + (1+ + (get-text-property + (prop-match-beginning + (text-property-search-backward 'vtable-column)) + 'vtable-column))))) + (start-x (car (posn-x-y pos-start))) + (end-x (car (posn-x-y (event-end e))))) + (when (or (> column 0) next) + (vtable--alter-column-width (vtable-current-table) + (if next + column + (1- column)) + (- end-x start-x))))))) + (defun vtable--recompute-numerical (table line) "Recompute numericalness of columns if necessary." (let ((columns (vtable-columns table)) @@ -665,7 +868,7 @@ This also updates the displayed table." (vtable-goto-column column)))) (defun vtable--widths (table) - (nth 1 (vtable--cache table))) + (nth 1 (vtable--ensure-cache table))) ;;; Commands. @@ -677,25 +880,36 @@ This also updates the displayed table." "Minor mode for buffers with vtables with headers." :keymap vtable-header-mode-map) -(defun vtable-narrow-current-column () - "Narrow the current column." - (interactive) +(defun vtable-narrow-current-column (&optional n) + "Narrow the current column by N characters. +If N isn't given, N defaults to 1. + +Interactively, N is the prefix argument." + (interactive "p") (let* ((table (vtable-current-table)) - (column (vtable-current-column)) - (widths (vtable--widths table))) + (column (vtable-current-column))) + (unless column + (user-error "No column under point")) + (vtable--alter-column-width table column + (- (* (vtable--char-width table) (or n 1)))))) + +(defun vtable--alter-column-width (table column delta) + (let ((widths (vtable--widths table))) (setf (aref widths column) (max (* (vtable--char-width table) 2) - (- (aref widths column) (vtable--char-width table)))) + (+ (aref widths column) delta))) + ;; Store the width so it'll be respected on a revert. + (setf (vtable-column-width (elt (vtable-columns table) column)) + (format "%dpx" (aref widths column))) (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-widen-current-column (&optional n) + "Widen the current column by N characters. +If N isn't given, N defaults to 1. + +Interactively, N is the prefix argument." + (interactive "p") + (vtable-narrow-current-column (- n))) (defun vtable-previous-column () "Go to the previous column." diff --git a/lisp/emulation/cua-rect.el b/lisp/emulation/cua-rect.el index e399fd0fbf3..a7f3d5fe14c 100644 --- a/lisp/emulation/cua-rect.el +++ b/lisp/emulation/cua-rect.el @@ -572,7 +572,7 @@ Only call fct for visible lines if VISIBLE==t. Set undo boundary if UNDO is non-nil. Rectangle is padded if PAD = t or numeric and (cua--rectangle-virtual-edges) Perform auto-tabify after operation if TABIFY is non-nil. -Mark is kept if keep-clear is 'keep and cleared if keep-clear is 'clear." +Mark is kept if keep-clear is `keep' and cleared if keep-clear is `clear'." (declare (indent 4)) (let* ((inhibit-field-text-motion t) (start (cua--rectangle-top)) diff --git a/lisp/emulation/viper-cmd.el b/lisp/emulation/viper-cmd.el index 83944285e91..ddb49609d40 100644 --- a/lisp/emulation/viper-cmd.el +++ b/lisp/emulation/viper-cmd.el @@ -1783,7 +1783,7 @@ Undo previous insertion and inserts new." (do-not-change-default t)) (setq quote-str (viper-read-string-with-history - "Quote string" + "Quote string: " nil 'viper-quote-region-history ;; FIXME: Use comment-region. @@ -1992,17 +1992,24 @@ problems." #'viper-minibuffer-standard-hook (if (or (not (listp old)) (eq (car old) 'lambda)) (list old) old)))) - (val "")) + (val "") + (padding "") + temp-msg) (setq keymap (or keymap minibuffer-local-map) initial (or initial "") - viper-initial initial) + viper-initial initial + temp-msg (if default + (format "(default %s) " default) + "")) (setq viper-incomplete-ex-cmd nil) - (setq val (read-from-minibuffer (format-prompt prompt default) - nil - keymap nil history-var default)) - (setq minibuffer-setup-hook nil) + (setq val (read-from-minibuffer prompt + (concat temp-msg initial val padding) + keymap nil history-var)) + (setq minibuffer-setup-hook nil + padding (viper-array-to-string (this-command-keys)) + temp-msg "") ;; the following tries to be smart about what to put in history (if (not (string= val (car (symbol-value history-var)))) (push val (symbol-value history-var))) @@ -3815,7 +3822,7 @@ Null string will repeat previous search." (let (buffer buffer-name) (setq buffer-name (funcall viper-read-buffer-function - (format-prompt "Kill buffer" + (format "Kill buffer (%s): " (buffer-name (current-buffer))))) (setq buffer (if (null buffer-name) @@ -4157,12 +4164,17 @@ cursor move past the beginning of line." "Query replace. If a null string is supplied as the string to be replaced, the query replace mode will toggle between string replace -and regexp replace." +and regexp replace. + +As each match is found, the user must type a character saying +what to do with it. Type SPC or `y' to replace the match, +DEL or `n' to skip and go to the next match. For more directions, +type \\[help-command] at that time." (interactive) (let (str) (setq str (viper-read-string-with-history - (if viper-re-query-replace "Query replace regexp" - "Query replace") + (if viper-re-query-replace "Query replace regexp: " + "Query replace: ") nil ; no initial 'viper-replace1-history (car viper-replace1-history) ; default @@ -4177,7 +4189,7 @@ and regexp replace." (query-replace-regexp str (viper-read-string-with-history - (format-message "Query replace regexp `%s' with" str) + (format-message "Query replace regexp `%s' with: " str) nil ; no initial 'viper-replace1-history (car viper-replace1-history) ; default @@ -4185,7 +4197,7 @@ and regexp replace." (query-replace str (viper-read-string-with-history - (format-message "Query replace `%s' with" str) + (format-message "Query replace `%s' with: " str) nil ; no initial 'viper-replace1-history (car viper-replace1-history) ; default diff --git a/lisp/emulation/viper-mous.el b/lisp/emulation/viper-mous.el index 7581ece2142..1a90cab7674 100644 --- a/lisp/emulation/viper-mous.el +++ b/lisp/emulation/viper-mous.el @@ -62,8 +62,8 @@ or a triple-click." ;; time interval in millisecond within which successive clicks are ;; considered related (defcustom viper-multiclick-timeout (if (viper-window-display-p) - double-click-time - 500) + (mouse-double-click-time) + 500) "Time interval in milliseconds for mouse clicks to be considered related." :type 'integer) diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 398fe6cc9e7..4b21711da42 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -464,7 +464,7 @@ If POS is out of range, the value is nil." (defun erc-bounds-of-word-at-point () "Return the bounds of word at point, or nil if we're not at a word. If no `subword-mode' is active, then this is -\(bounds-of-thing-at-point 'word)." +\(bounds-of-thing-at-point \\='word)." (if (or (erc-word-at-arg-p (point)) (erc-word-at-arg-p (1- (point)))) (save-excursion diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 52fe106f2d1..06381c5ebee 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -2269,7 +2269,7 @@ Example usage: (erc-tls :server \"irc.libera.chat\" :port 6697 :client-certificate - '(\"/home/bandali/my-cert.key\" + \\='(\"/home/bandali/my-cert.key\" \"/home/bandali/my-cert.crt\"))" (interactive (let ((erc-default-port erc-default-port-tls)) (erc-select-read-args))) diff --git a/lisp/eshell/em-dirs.el b/lisp/eshell/em-dirs.el index 3998026d7f4..5396044d8ca 100644 --- a/lisp/eshell/em-dirs.el +++ b/lisp/eshell/em-dirs.el @@ -313,7 +313,7 @@ With the following piece of advice, you can make this functionality available in most of Emacs, with the exception of filename completion in the minibuffer: - (advice-add 'expand-file-name :around #'my-expand-multiple-dots) + (advice-add \\='expand-file-name :around #\\='my-expand-multiple-dots) (defun my-expand-multiple-dots (orig-fun filename &rest args) (apply orig-fun (eshell-expand-multiple-dots filename) args))" (while (string-match "\\(?:\\`\\|/\\)\\.\\.\\(\\.+\\)\\(?:\\'\\|/\\)" diff --git a/lisp/eshell/em-elecslash.el b/lisp/eshell/em-elecslash.el new file mode 100644 index 00000000000..091acb9a861 --- /dev/null +++ b/lisp/eshell/em-elecslash.el @@ -0,0 +1,120 @@ +;;; em-elecslash.el --- electric forward slashes -*- lexical-binding:t -*- + +;; Copyright (C) 2022 Free Software Foundation, Inc. + +;; Author: Sean Whitton <spwhitton@spwhitton.name> + +;; 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: + +;; Electric forward slash in remote Eshells. + +;;; Code: + +(require 'tramp) +(require 'thingatpt) +(require 'esh-cmd) +(require 'esh-ext) +(require 'esh-mode) + +;; This makes us an option when customizing `eshell-modules-list'. +;;;###autoload +(progn +(defgroup eshell-elecslash nil + "Electric forward slash in remote Eshells. + +This module helps with supplying absolute file name arguments to +remote commands. After enabling it, typing a forward slash as +the first character of a command line argument will automatically +insert the Tramp prefix, /method:host:. The automatic insertion +applies only when `default-directory' is remote and the command +is a Lisp function. + +The result is that in most cases of supplying absolute file name +arguments to commands you should see the Tramp prefix inserted +automatically only when that's what you'd reasonably expect. +This frees you from having to keep track of whether commands are +Lisp functions or external when typing command line arguments." + :tag "Electric forward slash" + :group 'eshell-module)) + +;;; Functions: + +(defun eshell-elecslash-initialize () ;Called from `eshell-mode' via intern-soft! + "Initialize remote Eshell electric forward slash support." + (add-hook 'post-self-insert-hook + #'eshell-electric-forward-slash nil t)) + +(defun eshell-electric-forward-slash () + "Implementation of electric forward slash in remote Eshells. + +Initializing the `eshell-elecslash' module adds this function to +`post-self-insert-hook'. Typing / or ~/ as the first character +of a command line argument automatically inserts the Tramp prefix +in the case that `default-directory' is remote and the command is +a Lisp function. Typing a second forward slash undoes the +insertion." + (when (eq ?/ (char-before)) + (delete-char -1) + (let ((tilde-before (eq ?~ (char-before))) + (command (save-excursion + (eshell-bol) + (skip-syntax-forward " ") + (thing-at-point 'sexp)))) + (if (and (file-remote-p default-directory) + ;; We can't formally parse the input. But if there is + ;; one of these operators behind us, then looking at + ;; the first command would not be sensible. So be + ;; conservative: don't insert the Tramp prefix if there + ;; are any of these operators behind us. + (not (looking-back (regexp-opt '("&&" "|" ";")) + eshell-last-output-end)) + (or (= (point) eshell-last-output-end) + (and tilde-before + (= (1- (point)) eshell-last-output-end)) + (and (or tilde-before + (eq ?\s (char-syntax (char-before)))) + (or (eshell-find-alias-function command) + (and (fboundp (intern-soft command)) + (or eshell-prefer-lisp-functions + (not (eshell-search-path command)))))))) + (let ((map (make-sparse-keymap)) + (start (if tilde-before (1- (point)) (point))) + (localname + (tramp-file-name-localname + (tramp-dissect-file-name default-directory)))) + (when tilde-before (delete-char -1)) + (insert + (substring default-directory 0 + (string-search localname default-directory))) + (unless tilde-before (insert "/")) + ;; Typing a second slash undoes the insertion, for when + ;; you really do want to type a local absolute file name. + (define-key map "/" (lambda () + (interactive) + (delete-region start (point)) + (insert (if tilde-before "~/" "/")))) + (set-transient-map map)) + (insert "/"))))) + +(provide 'em-elecslash) + +;; Local Variables: +;; generated-autoload-file: "esh-groups.el" +;; End: + +;;; esh-elecslash.el ends here diff --git a/lisp/eshell/em-glob.el b/lisp/eshell/em-glob.el index 842f27a4920..52531ff8939 100644 --- a/lisp/eshell/em-glob.el +++ b/lisp/eshell/em-glob.el @@ -233,7 +233,10 @@ resulting regular expression." "\\'"))) (defun eshell-extended-glob (glob) - "Return a list of files generated from GLOB, perhaps looking for DIRS-ONLY. + "Return a list of files matched by GLOB. +If no files match, signal an error (if `eshell-error-if-no-glob' +is non-nil), or otherwise return GLOB itself. + This function almost fully supports zsh style filename generation syntax. Things that are not supported are: @@ -243,12 +246,7 @@ syntax. Things that are not supported are: foo~x(a|b) (a|b) will be interpreted as a predicate/modifier list Mainly they are not supported because file matching is done with Emacs -regular expressions, and these cannot support the above constructs. - -If this routine fails, it returns nil. Otherwise, it returns a list -the form: - - (INCLUDE-REGEXP EXCLUDE-REGEXP (PRED-FUNC-LIST) (MOD-FUNC-LIST))" +regular expressions, and these cannot support the above constructs." (let ((paths (eshell-split-path glob)) eshell-glob-matches message-shown) (unwind-protect @@ -287,7 +285,7 @@ the form: glob (car globs) len (length glob))))) (if (and recurse-p (not glob)) - (error "`**' cannot end a globbing pattern")) + (error "`**/' cannot end a globbing pattern")) (let ((index 1)) (setq incl glob) (while (and (eq incl glob) diff --git a/lisp/eshell/em-pred.el b/lisp/eshell/em-pred.el index 970329e12a9..d73976d3464 100644 --- a/lisp/eshell/em-pred.el +++ b/lisp/eshell/em-pred.el @@ -68,7 +68,7 @@ ordinary strings." (defcustom eshell-predicate-alist '((?/ . (eshell-pred-file-type ?d)) ; directories (?. . (eshell-pred-file-type ?-)) ; regular files - (?s . (eshell-pred-file-type ?s)) ; sockets + (?= . (eshell-pred-file-type ?s)) ; sockets (?p . (eshell-pred-file-type ?p)) ; named pipes (?@ . (eshell-pred-file-type ?l)) ; symbolic links (?% . (eshell-pred-file-type ?%)) ; allow user to specify (c def.) @@ -88,17 +88,17 @@ ordinary strings." (if (file-exists-p file) (= (file-attribute-user-id (file-attributes file)) (user-uid))))) - ;; (?G . (lambda (file) ; owned by effective gid - ;; (if (file-exists-p file) - ;; (= (file-attribute-user-id (file-attributes file)) - ;; (user-uid))))) + (?G . (lambda (file) ; owned by effective gid + (if (file-exists-p file) + (= (file-attribute-group-id (file-attributes file)) + (group-gid))))) (?* . (lambda (file) (and (file-regular-p file) (not (file-symlink-p file)) (file-executable-p file)))) (?l . (eshell-pred-file-links)) - (?u . (eshell-pred-user-or-group ?u "user" 2 'eshell-user-id)) - (?g . (eshell-pred-user-or-group ?g "group" 3 'eshell-group-id)) + (?u . (eshell-pred-user-or-group ?u "user" 2 #'eshell-user-id)) + (?g . (eshell-pred-user-or-group ?g "group" 3 #'eshell-group-id)) (?a . (eshell-pred-file-time ?a "access" 4)) (?m . (eshell-pred-file-time ?m "modification" 5)) (?c . (eshell-pred-file-time ?c "change" 6)) @@ -111,28 +111,23 @@ The format of each entry is :risky t) (defcustom eshell-modifier-alist - '((?E . (lambda (lst) - (mapcar - (lambda (str) - (eshell-stringify - (car (eshell-parse-argument str)))) - lst))) + '((?E . (lambda (lst) (mapcar #'eshell-eval-argument lst))) (?L . (lambda (lst) (mapcar #'downcase lst))) (?U . (lambda (lst) (mapcar #'upcase lst))) (?C . (lambda (lst) (mapcar #'capitalize lst))) (?h . (lambda (lst) (mapcar #'file-name-directory lst))) - (?i . (eshell-include-members)) - (?x . (eshell-include-members t)) + (?i . (eshell-include-members ?i)) + (?x . (eshell-include-members ?x t)) (?r . (lambda (lst) (mapcar #'file-name-sans-extension lst))) (?e . (lambda (lst) (mapcar #'file-name-extension lst))) (?t . (lambda (lst) (mapcar #'file-name-nondirectory lst))) (?q . (lambda (lst) (mapcar #'eshell-escape-arg lst))) (?u . (lambda (lst) (seq-uniq lst))) (?o . (lambda (lst) (sort lst #'string-lessp))) - (?O . (lambda (lst) (nreverse (sort lst #'string-lessp)))) + (?O . (lambda (lst) (sort lst #'string-greaterp))) (?j . (eshell-join-members)) (?S . (eshell-split-members)) - (?R . 'reverse) + (?R . #'reverse) (?g . (progn (forward-char) (if (eq (char-before) ?s) @@ -142,7 +137,7 @@ The format of each entry is "A list of modifiers than can be applied to an argument expansion. The format of each entry is - (CHAR ENTRYWISE-P MODIFIER-FUNC-SEXP)" + (CHAR . MODIFIER-FUNC-SEXP)" :type '(repeat (cons character sexp)) :risky t) @@ -166,6 +161,7 @@ PERMISSION BITS (for owner/group/world): OWNERSHIP: U owned by effective uid + G owned by effective gid u(UID|\\='user\\=') owned by UID/user g(GID|\\='group\\=') owned by GID/group @@ -217,12 +213,26 @@ FOR LISTS OF ARGUMENTS: i/PAT/ exclude all members not matching PAT x/PAT/ exclude all members matching PAT - s/pat/match/ substitute PAT with MATCH - g/pat/match/ substitute PAT with MATCH for all occurrences + s/pat/match/ substitute PAT with MATCH + gs/pat/match/ substitute PAT with MATCH for all occurrences EXAMPLES: *.c(:o) sorted list of .c files") +(defvar eshell-pred-delimiter-pairs + '((?\( . ?\)) + (?\[ . ?\]) + (?\< . ?\>) + (?\{ . ?\}) + (?\' . ?\') + (?\" . ?\") + (?/ . ?/) + (?| . ?|)) + "A list of delimiter pairs that can be used in argument predicates/modifiers. +Each element is of the form (OPEN . CLOSE), where OPEN and CLOSE +are characters representing the opening and closing delimiter, +respectively.") + (defvar-keymap eshell-pred-mode-map "C-c M-q" #'eshell-display-predicate-help "C-c M-m" #'eshell-display-modifier-help) @@ -368,38 +378,70 @@ resultant list of strings." (lambda (file) (funcall pred (file-truename file)))))) (cons pred funcs)) +(defun eshell-get-comparison-modifier-argument (&optional functions) + "Starting at point, get the comparison modifier argument, if any. +These are the -/+ characters, corresponding to `<' and `>', +respectively. If no comparison modifier is at point, return `='. + +FUNCTIONS, if non-nil, is a list of comparison functions, +specified as (LESS-THAN GREATER-THAN EQUAL-TO)." + (let ((functions (or functions (list #'< #'> #'=)))) + (if (memq (char-after) '(?- ?+)) + (prog1 + (if (eq (char-after) ?-) (nth 0 functions) (nth 1 functions)) + (forward-char)) + (nth 2 functions)))) + +(defun eshell-get-numeric-modifier-argument () + "Starting at point, get the numeric modifier argument, if any. +If a number is found, update point to just after the number." + (when (looking-at "[0-9]+") + (prog1 + (string-to-number (match-string 0)) + (goto-char (match-end 0))))) + +(defun eshell-get-delimited-modifier-argument (&optional chained-p) + "Starting at point, get the delimited modifier argument, if any. +If the character after point is a predicate/modifier +delimiter (see `eshell-pred-delimiter-pairs', read the value of +the argument and update point to be just after the closing +delimiter. + +If CHAINED-P is true, then another delimited modifier argument +will immediately follow this one. In this case, when the opening +and closing delimiters are the same, update point to be just +before the closing delimiter. This allows modifiers like +`:s/match/repl' to work as expected." + (when-let* ((open (char-after)) + (close (cdr (assoc open eshell-pred-delimiter-pairs))) + (end (eshell-find-delimiter open close nil nil t))) + (prog1 + (replace-regexp-in-string + (rx-to-string `(seq "\\" (group (or "\\" ,open ,close)))) "\\1" + (buffer-substring-no-properties (1+ (point)) end)) + (goto-char (if (and chained-p (eq open close)) + end + (1+ end)))))) + (defun eshell-pred-user-or-group (mod-char mod-type attr-index get-id-func) "Return a predicate to test whether a file match a given user/group id." - (let (ugid open close end) - (if (looking-at "[0-9]+") - (progn - (setq ugid (string-to-number (match-string 0))) - (goto-char (match-end 0))) - (setq open (char-after)) - (if (setq close (memq open '(?\( ?\[ ?\< ?\{))) - (setq close (car (last '(?\) ?\] ?\> ?\}) - (length close)))) - (setq close open)) - (forward-char) - (setq end (eshell-find-delimiter open close)) - (unless end - (error "Malformed %s name string for modifier `%c'" - mod-type mod-char)) - (setq ugid - (funcall get-id-func (buffer-substring (point) end))) - (goto-char (1+ end))) + (let ((ugid (eshell-get-numeric-modifier-argument))) + (unless ugid + (let ((ugname (or (eshell-get-delimited-modifier-argument) + (error "Malformed %s name string for modifier `%c'" + mod-type mod-char)))) + (setq ugid (funcall get-id-func ugname)))) (unless ugid (error "Unknown %s name specified for modifier `%c'" mod-type mod-char)) (lambda (file) - (let ((attrs (file-attributes file))) - (if attrs - (= (nth attr-index attrs) ugid)))))) + (when-let ((attrs (file-attributes file))) + (= (nth attr-index attrs) ugid))))) (defun eshell-pred-file-time (mod-char mod-type attr-index) "Return a predicate to test whether a file matches a certain time." (let* ((quantum 86400) - qual when open close end) + qual when) (when (memq (char-after) '(?M ?w ?h ?m ?s)) (setq quantum (char-after)) (cond @@ -414,36 +456,21 @@ resultant list of strings." ((eq quantum ?s) (setq quantum 1))) (forward-char)) - (when (memq (char-after) '(?+ ?-)) - (setq qual (char-after)) - (forward-char)) - (if (looking-at "[0-9]+") - (progn - (setq when (time-since (* (string-to-number (match-string 0)) - quantum))) - (goto-char (match-end 0))) - (setq open (char-after)) - (if (setq close (memq open '(?\( ?\[ ?\< ?\{))) - (setq close (car (last '(?\) ?\] ?\> ?\}) - (length close)))) - (setq close open)) - (forward-char) - (setq end (eshell-find-delimiter open close)) - (unless end - (error "Malformed %s time modifier `%c'" mod-type mod-char)) - (let* ((file (buffer-substring (point) end)) - (attrs (file-attributes file))) - (unless attrs - (error "Cannot stat file `%s'" file)) - (setq when (nth attr-index attrs))) - (goto-char (1+ end))) - (let ((f (cond ((eq qual ?-) #'time-less-p) - ((eq qual ?+) (lambda (a b) (time-less-p b a))) - (#'time-equal-p)))) - (lambda (file) - (let ((attrs (file-attributes file))) - (if attrs - (funcall f when (nth attr-index attrs)))))))) + (setq qual (eshell-get-comparison-modifier-argument + (list #'time-less-p + (lambda (a b) (time-less-p b a)) + #'time-equal-p))) + (if-let ((number (eshell-get-numeric-modifier-argument))) + (setq when (time-since (* number quantum))) + (let* ((file (or (eshell-get-delimited-modifier-argument) + (error "Malformed %s time modifier `%c'" + mod-type mod-char))) + (attrs (or (file-attributes file) + (error "Cannot stat file `%s'" file)))) + (setq when (nth attr-index attrs)))) + (lambda (file) + (when-let ((attrs (file-attributes file))) + (funcall qual when (nth attr-index attrs)))))) (defun eshell-pred-file-type (type) "Return a test which tests that the file is of a certain TYPE. @@ -458,36 +485,23 @@ that `ls -l' will show in the first column of its display." '(?b ?c) (list type)))) (lambda (file) - (let ((attrs (eshell-file-attributes (directory-file-name file)))) - (if attrs - (memq (aref (file-attribute-modes attrs) 0) set)))))) + (when-let ((attrs (eshell-file-attributes (directory-file-name file)))) + (memq (aref (file-attribute-modes attrs) 0) set))))) (defsubst eshell-pred-file-mode (mode) "Return a test which tests that MODE pertains to the file." (lambda (file) - (let ((modes (file-modes file 'nofollow))) - (if modes - (not (zerop (logand mode modes))))))) + (when-let ((modes (file-modes file 'nofollow))) + (not (zerop (logand mode modes)))))) (defun eshell-pred-file-links () "Return a predicate to test whether a file has a given number of links." - (let (qual amount) - (when (memq (char-after) '(?- ?+)) - (setq qual (char-after)) - (forward-char)) - (unless (looking-at "[0-9]+") - (error "Invalid file link count modifier `l'")) - (setq amount (string-to-number (match-string 0))) - (goto-char (match-end 0)) - (let ((f (if (eq qual ?-) - #'< - (if (eq qual ?+) - #'> - #'=)))) - (lambda (file) - (let ((attrs (eshell-file-attributes file))) - (if attrs - (funcall f (file-attribute-link-number attrs) amount))))))) + (let ((qual (eshell-get-comparison-modifier-argument)) + (amount (or (eshell-get-numeric-modifier-argument) + (error "Invalid file link count modifier `l'")))) + (lambda (file) + (when-let ((attrs (eshell-file-attributes file))) + (funcall qual (file-attribute-link-number attrs) amount))))) (defun eshell-pred-file-size () "Return a predicate to test whether a file is of a given size." @@ -502,89 +516,52 @@ that `ls -l' will show in the first column of its display." ((eq qual ?p) (setq quantum 512))) (forward-char)) - (when (memq (char-after) '(?- ?+)) - (setq qual (char-after)) - (forward-char)) - (unless (looking-at "[0-9]+") - (error "Invalid file size modifier `L'")) - (setq amount (* (string-to-number (match-string 0)) quantum)) - (goto-char (match-end 0)) - (let ((f (if (eq qual ?-) - #'< - (if (eq qual ?+) - #'> - #'=)))) - (lambda (file) - (let ((attrs (eshell-file-attributes file))) - (if attrs - (funcall f (file-attribute-size attrs) amount))))))) + (setq qual (eshell-get-comparison-modifier-argument)) + (setq amount (* (or (eshell-get-numeric-modifier-argument) + (error "Invalid file size modifier `L'")) + quantum)) + (lambda (file) + (when-let ((attrs (eshell-file-attributes file))) + (funcall qual (file-attribute-size attrs) amount))))) (defun eshell-pred-substitute (&optional repeat) "Return a modifier function that will substitute matches." - (let ((delim (char-after)) - match replace end) - (forward-char) - (setq end (eshell-find-delimiter delim delim nil nil t) - match (buffer-substring-no-properties (point) end)) - (goto-char (1+ end)) - (setq end (eshell-find-delimiter delim delim nil nil t) - replace (buffer-substring-no-properties (point) end)) - (goto-char (1+ end)) - (if repeat - (lambda (lst) - (mapcar - (lambda (str) - (let ((i 0)) - (while (setq i (string-match match str i)) - (setq str (replace-match replace t nil str)))) - str) - lst)) - (lambda (lst) - (mapcar - (lambda (str) - (if (string-match match str) - (setq str (replace-match replace t nil str)) - (error (concat str ": substitution failed"))) - str) - lst))))) - -(defun eshell-include-members (&optional invert-p) - "Include only Lisp members matching a regexp." - (let ((delim (char-after)) - regexp end) - (forward-char) - (setq end (eshell-find-delimiter delim delim nil nil t) - regexp (buffer-substring-no-properties (point) end)) - (goto-char (1+ end)) - (let ((predicates - (list (if invert-p - (lambda (elem) (not (string-match regexp elem))) - (lambda (elem) (string-match regexp elem)))))) - (lambda (lst) - (eshell-winnow-list lst nil predicates))))) + (let* ((match (or (eshell-get-delimited-modifier-argument t) + (error "Malformed pattern string for modifier `s'"))) + (replace (or (eshell-get-delimited-modifier-argument) + (error "Malformed replace string for modifier `s'"))) + (function (if repeat + (lambda (str) + (replace-regexp-in-string match replace str t)) + (lambda (str) + (if (string-match match str) + (replace-match replace t nil str) + (error (concat str ": substitution failed"))))))) + (lambda (lst) (mapcar function lst)))) + +(defun eshell-include-members (mod-char &optional invert-p) + "Include only Lisp members matching a regexp. +If INVERT-P is non-nil, include only members not matching a regexp." + (let* ((regexp (or (eshell-get-delimited-modifier-argument) + (error "Malformed pattern string for modifier `%c'" + mod-char))) + (predicates + (list (if invert-p + (lambda (elem) (not (string-match regexp elem))) + (lambda (elem) (string-match regexp elem)))))) + (lambda (lst) + (eshell-winnow-list lst nil predicates)))) (defun eshell-join-members () "Return a modifier function that join matches." - (let ((delim (char-after)) - str end) - (if (not (memq delim '(?' ?/))) - (setq delim " ") - (forward-char) - (setq end (eshell-find-delimiter delim delim nil nil t) - str (buffer-substring-no-properties (point) end)) - (goto-char (1+ end))) + (let ((str (or (eshell-get-delimited-modifier-argument) + " "))) (lambda (lst) (mapconcat #'identity lst str)))) (defun eshell-split-members () "Return a modifier function that splits members." - (let ((delim (char-after)) - sep end) - (when (memq delim '(?' ?/)) - (forward-char) - (setq end (eshell-find-delimiter delim delim nil nil t) - sep (buffer-substring-no-properties (point) end)) - (goto-char (1+ end))) + (let ((sep (eshell-get-delimited-modifier-argument))) (lambda (lst) (mapcar (lambda (str) diff --git a/lisp/eshell/esh-arg.el b/lisp/eshell/esh-arg.el index ee3f907f85c..459487f4358 100644 --- a/lisp/eshell/esh-arg.el +++ b/lisp/eshell/esh-arg.el @@ -180,19 +180,63 @@ treated as a literal character." (add-text-properties 0 (length string) '(escaped t) string)) string) +(defun eshell-concat (quoted &rest rest) + "Concatenate all the arguments in REST and return the result. +If QUOTED is nil, the resulting value(s) may be converted to +numbers (see `eshell-concat-1'). + +If each argument in REST is a non-list value, the result will be +a single value, as if (mapconcat #'eshell-stringify REST) had been +called, possibly converted to a number. + +If there is at least one (non-nil) list argument, the result will +be a list, with \"adjacent\" elements of consecutive arguments +concatenated as strings (again, possibly converted to numbers). +For example, concatenating \"a\", (\"b\"), and (\"c\" \"d\") +would produce (\"abc\" \"d\")." + (let (result) + (dolist (i rest result) + (when i + (cond + ((null result) + (setq result i)) + ((listp result) + (let (curr-head curr-tail) + (if (listp i) + (setq curr-head (car i) + curr-tail (cdr i)) + (setq curr-head i + curr-tail nil)) + (setq result + (append + (butlast result 1) + (list (eshell-concat-1 quoted (car (last result)) + curr-head)) + curr-tail)))) + ((listp i) + (setq result + (cons (eshell-concat-1 quoted result (car i)) + (cdr i)))) + (t + (setq result (eshell-concat-1 quoted result i)))))))) + +(defun eshell-concat-1 (quoted first second) + "Concatenate FIRST and SECOND. +If QUOTED is nil and either FIRST or SECOND are numbers, try to +convert the result to a number as well." + (let ((result (concat (eshell-stringify first) (eshell-stringify second)))) + (if (and (not quoted) + (or (numberp first) (numberp second))) + (eshell-convert-to-number result) + result))) + (defun eshell-resolve-current-argument () "If there are pending modifications to be made, make them now." (when eshell-current-argument (when eshell-arg-listified - (let ((parts eshell-current-argument)) - (while parts - (unless (stringp (car parts)) - (setcar parts - (list 'eshell-to-flat-string (car parts)))) - (setq parts (cdr parts))) - (setq eshell-current-argument - (list 'eshell-convert - (append (list 'concat) eshell-current-argument)))) + (setq eshell-current-argument + (append (list 'eshell-concat eshell-current-quoted) + eshell-current-argument)) (setq eshell-arg-listified nil)) (while eshell-current-modifiers (setq eshell-current-argument @@ -401,7 +445,9 @@ If the form has no `type', the syntax is parsed as if `type' were (if (eshell-arg-delimiter (1+ end)) (prog1 (list (if buffer-p 'get-buffer-create 'get-process) - (buffer-substring-no-properties (point) end)) + (replace-regexp-in-string + (rx "\\" (group (or "\\" "<" ">"))) "\\1" + (buffer-substring-no-properties (point) end))) (goto-char (1+ end))) (ignore (goto-char here))))))) diff --git a/lisp/eshell/esh-cmd.el b/lisp/eshell/esh-cmd.el index 8be1136e311..42616e7037d 100644 --- a/lisp/eshell/esh-cmd.el +++ b/lisp/eshell/esh-cmd.el @@ -1002,6 +1002,14 @@ produced by `eshell-parse-command'." (let ((base (cadr (nth 2 (nth 2 (cadr command)))))) (eshell--invoke-command-directly base))) +(defun eshell-eval-argument (argument) + "Evaluate a single Eshell ARGUMENT and return the result." + (let* ((form (eshell-with-temp-command argument + (eshell-parse-argument))) + (result (eshell-do-eval form t))) + (cl-assert (eq (car result) 'quote)) + (cadr result))) + (defun eshell-eval-command (command &optional input) "Evaluate the given COMMAND iteratively." (if eshell-current-command diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el index 8089d4d74b6..b5a423f0237 100644 --- a/lisp/eshell/esh-util.el +++ b/lisp/eshell/esh-util.el @@ -198,23 +198,51 @@ doubling it up." (when (= depth 0) (if reverse-p (point) (1- (point))))))) -(defun eshell-convert (string) - "Convert STRING into a more native looking Lisp object." - (if (not (stringp string)) - string - (let ((len (length string))) - (if (= len 0) - string - (if (eq (aref string (1- len)) ?\n) +(defun eshell-convertible-to-number-p (string) + "Return non-nil if STRING can be converted to a number. +If `eshell-convert-numeric-aguments', always return nil." + (and eshell-convert-numeric-arguments + (string-match + (concat "\\`\\s-*" eshell-number-regexp "\\s-*\\'") + string))) + +(defun eshell-convert-to-number (string) + "Try to convert STRING to a number. +If STRING doesn't look like a number (or +`eshell-convert-numeric-aguments' is nil), just return STRING +unchanged." + (if (eshell-convertible-to-number-p string) + (string-to-number string) + string)) + +(defun eshell-convert (string &optional to-string) + "Convert STRING into a more-native Lisp object. +If TO-STRING is non-nil, always return a single string with +trailing newlines removed. Otherwise, this behaves as follows: + +* Return non-strings as-is. + +* Split multiline strings by line. + +* If `eshell-convert-numeric-aguments' is non-nil and every line + of output looks like a number, convert them to numbers." + (cond + ((not (stringp string)) + (if to-string + (eshell-stringify string) + string)) + (to-string (string-trim-right string "\n+")) + (t (let ((len (length string))) + (if (= len 0) + string + (when (eq (aref string (1- len)) ?\n) (setq string (substring string 0 (1- len)))) - (if (string-search "\n" string) - (split-string string "\n") - (if (and eshell-convert-numeric-arguments - (string-match - (concat "\\`\\s-*" eshell-number-regexp - "\\s-*\\'") string)) - (string-to-number string) - string)))))) + (if (string-search "\n" string) + (let ((lines (split-string string "\n"))) + (if (seq-every-p #'eshell-convertible-to-number-p lines) + (mapcar #'string-to-number lines) + lines)) + (eshell-convert-to-number string))))))) (defvar-local eshell-path-env (getenv "PATH") "Content of $PATH. @@ -265,6 +293,7 @@ Prepend remote identification of `default-directory', if any." (defun eshell-to-flat-string (value) "Make value a string. If separated by newlines change them to spaces." + (declare (obsolete nil "29.1")) (let ((text (eshell-stringify value))) (if (string-match "\n+\\'" text) (setq text (replace-match "" t t text))) @@ -592,11 +621,11 @@ list." The optional argument ID-FORMAT specifies the preferred uid and gid format. Valid values are `string' and `integer', defaulting to `integer'. See `file-attributes'." - (let* ((file (expand-file-name file)) + (let* ((expanded-file (expand-file-name file)) entry) - (if (string-equal (file-remote-p file 'method) "ftp") - (let ((base (file-name-nondirectory file)) - (dir (file-name-directory file))) + (if (string-equal (file-remote-p expanded-file 'method) "ftp") + (let ((base (file-name-nondirectory expanded-file)) + (dir (file-name-directory expanded-file))) (if (string-equal "" base) (setq base ".")) (unless entry (setq entry (eshell-parse-ange-ls dir)) diff --git a/lisp/eshell/esh-var.el b/lisp/eshell/esh-var.el index ca4cbd744c1..1c28d24af12 100644 --- a/lisp/eshell/esh-var.el +++ b/lisp/eshell/esh-var.el @@ -402,27 +402,34 @@ process any indices that come after the variable reference." (let* ((get-len (when (eq (char-after) ?#) (forward-char) t)) value indices) - (setq value (eshell-parse-variable-ref) + (setq value (eshell-parse-variable-ref get-len) indices (and (not (eobp)) (eq (char-after) ?\[) (eshell-parse-indices)) ;; This is an expression that will be evaluated by `eshell-do-eval', ;; which only support let-binding of dynamically-scoped vars value `(let ((indices (eshell-eval-indices ',indices))) ,value)) - (if get-len - `(length ,value) - value))) + (when get-len + (setq value `(length ,value))) + (when eshell-current-quoted + (setq value `(eshell-stringify ,value))) + value)) -(defun eshell-parse-variable-ref () +(defun eshell-parse-variable-ref (&optional modifier-p) "Eval a variable reference. Returns a Lisp form which, if evaluated, will return the value of the variable. -Possible options are: +If MODIFIER-P is non-nil, the value of the variable will be +modified by some function. If MODIFIER-P is nil, the value will be +used as-is; this allows optimization of some kinds of variable +references. + +Possible variable references are: NAME an environment or Lisp variable value \"LONG-NAME\" disambiguates the length of the name - 'LONG-NAME' as above + `LONG-NAME' as above {COMMAND} result of command is variable's value (LISP-FORM) result of Lisp form is variable's value <COMMAND> write the output of command to a temporary file; @@ -441,8 +448,16 @@ Possible options are: ,(let ((subcmd (or (eshell-unescape-inner-double-quote end) (cons (point) end))) (eshell-current-quoted nil)) - (eshell-parse-command subcmd))))) - indices) + (eshell-parse-command subcmd)))) + ;; If this is a simple double-quoted form like + ;; "${COMMAND}" (i.e. no indices after the subcommand + ;; and no `#' modifier before), ensure we convert to a + ;; single string. This avoids unnecessary work + ;; (e.g. splitting the output by lines) when it would + ;; just be joined back together afterwards. + ,(when (and (not modifier-p) eshell-current-quoted) + '(not indices))) + indices ,eshell-current-quoted) (goto-char (1+ end)))))) ((eq (char-after) ?\<) (let ((end (eshell-find-delimiter ?\< ?\>))) @@ -466,7 +481,7 @@ Possible options are: ;; properly. See bug#54190. (list (function (lambda () (delete-file ,temp)))))) - (eshell-apply-indices ,temp indices))) + (eshell-apply-indices ,temp indices ,eshell-current-quoted))) (goto-char (1+ end))))))) ((eq (char-after) ?\() (condition-case nil @@ -475,7 +490,7 @@ Possible options are: (eshell-lisp-command ',(read (or (eshell-unescape-inner-double-quote (point-max)) (current-buffer))))) - indices) + indices ,eshell-current-quoted) (end-of-file (throw 'eshell-incomplete ?\()))) ((looking-at (rx-to-string @@ -487,14 +502,15 @@ Possible options are: (eshell-parse-literal-quote) (eshell-parse-double-quote)))) (when name - `(eshell-get-variable ,(eval name) indices))))) + `(eshell-get-variable ,(eval name) indices ,eshell-current-quoted))))) ((assoc (char-to-string (char-after)) eshell-variable-aliases-list) (forward-char) - `(eshell-get-variable ,(char-to-string (char-before)) indices)) + `(eshell-get-variable ,(char-to-string (char-before)) indices + ,eshell-current-quoted)) ((looking-at eshell-variable-name-regexp) (prog1 - `(eshell-get-variable ,(match-string 0) indices) + `(eshell-get-variable ,(match-string 0) indices ,eshell-current-quoted) (goto-char (match-end 0)))) (t (error "Invalid variable reference")))) @@ -525,8 +541,10 @@ For example, \"[0 1][2]\" becomes: "Evaluate INDICES, a list of index-lists generated by `eshell-parse-indices'." (mapcar (lambda (i) (mapcar #'eval i)) indices)) -(defun eshell-get-variable (name &optional indices) - "Get the value for the variable NAME." +(defun eshell-get-variable (name &optional indices quoted) + "Get the value for the variable NAME. +INDICES is a list of index-lists (see `eshell-parse-indices'). +If QUOTED is non-nil, this was invoked inside double-quotes." (let* ((alias (assoc name eshell-variable-aliases-list)) (var (if alias (cadr alias) @@ -547,9 +565,9 @@ For example, \"[0 1][2]\" becomes: (symbol-value var)) (t (error "Unknown variable `%s'" (eshell-stringify var)))) - indices)))) + indices quoted)))) -(defun eshell-apply-indices (value indices) +(defun eshell-apply-indices (value indices &optional quoted) "Apply to VALUE all of the given INDICES, returning the sub-result. The format of INDICES is: @@ -558,12 +576,17 @@ The format of INDICES is: Each member of INDICES represents a level of nesting. If the first member of a sublist is not an integer or name, and the value it's -reference is a string, that will be used as the regexp with which is -to divide the string into sub-parts. The default is whitespace. +referencing is a string, that will be used as the regexp with which +is to divide the string into sub-parts. The default is whitespace. Otherwise, each INT-OR-NAME refers to an element of the list value. Integers imply a direct index, and names, an associate lookup using `assoc'. +If QUOTED is non-nil, this was invoked inside double-quotes. This +affects the behavior of splitting strings: without quoting, the +split values are converted to Lisp forms via `eshell-convert'; with +quoting, they're left as strings. + For example, to retrieve the second element of a user's record in '/etc/passwd', the variable reference would look like: @@ -577,7 +600,7 @@ For example, to retrieve the second element of a user's record in (setq separator index refs (cdr refs))) (setq value - (mapcar #'eshell-convert + (mapcar (lambda (i) (eshell-convert i quoted)) (split-string value separator))))) (cond ((< (length refs) 0) diff --git a/lisp/faces.el b/lisp/faces.el index b4e1f03eef6..12a386c8f63 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -449,6 +449,10 @@ of FACE on FRAME." (defun face-attribute (face attribute &optional frame inherit) "Return the value of FACE's ATTRIBUTE on FRAME. + +See `set-face-attribute' for the list of supported attributes +and their meanings and allowed values. + 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). If FRAME is omitted or nil, use the selected frame. @@ -1858,8 +1862,8 @@ on which one provides better contrast with COLOR." "#ffffff" "black")) (defconst color-luminance-dark-limit 0.325 - "The relative luminance below which a color is considered 'dark'. -A 'dark' color in this sense provides better contrast with white + "The relative luminance below which a color is considered \"dark\". +A \"dark\" color in this sense provides better contrast with white than with black; see `color-dark-p'. This value was determined experimentally.") @@ -2873,7 +2877,10 @@ Note: Other faces cannot inherit from the cursor face." '((default :box (:line-width 1 :style released-button) :foreground "black") - (((type x w32 ns haiku pgtk) (class color)) + (((type haiku)) + :foreground "B_MENU_ITEM_TEXT_COLOR" + :background "B_MENU_BACKGROUND_COLOR") + (((type x w32 ns pgtk) (class color)) :background "grey75") (((type x) (class mono)) :background "grey")) diff --git a/lisp/files.el b/lisp/files.el index 2aa6c9dedc6..2b0dc54db8f 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -3899,8 +3899,8 @@ inhibited." (with-demoted-errors "Directory-local variables error: %s" ;; Note this is a no-op if enable-local-variables is nil. (hack-dir-local-variables)) - (let ((result (append (hack-local-variables--find-variables) - (hack-local-variables-prop-line)))) + (let ((result (append (hack-local-variables--find-variables handle-mode) + (hack-local-variables-prop-line handle-mode)))) (if (and enable-local-variables (not (inhibit-local-variables-p))) (progn @@ -3978,8 +3978,7 @@ major-mode." (forward-line 1)) (goto-char (point-min)) - (while (not (or (eobp) - (and (eq handle-mode t) result))) + (while (not (eobp)) ;; Find the variable name; (unless (looking-at hack-local-variable-regexp) (user-error "Malformed local variable line: %S" @@ -4005,7 +4004,8 @@ major-mode." (not (string-match "-minor\\'" (setq val2 (downcase (symbol-name val))))) - (setq result (intern (concat val2 "-mode")))) + ;; Allow several mode: elements. + (push (intern (concat val2 "-mode")) result)) (cond ((eq var 'coding)) ((eq var 'lexical-binding) (unless hack-local-variables--warned-lexical @@ -4029,7 +4029,10 @@ major-mode." val) result)))))) (forward-line 1))))))) - result)) + (if (eq handle-mode t) + ;; Return the final mode: setting that's defined. + (car (seq-filter #'fboundp result)) + result))) (defun hack-local-variables-apply () "Apply the elements of `file-local-variables-alist'. @@ -7325,7 +7328,9 @@ need to be passed verbatim to shell commands." (defvar insert-directory-program (purecopy "ls") - "Absolute or relative name of the `ls' program used by `insert-directory'.") + "Absolute or relative name of the `ls'-like program. +This is used by `insert-directory' and `dired-insert-directory' +\(thus, also by `dired').") (defcustom directory-free-space-program (purecopy "df") "Program to get the amount of free space on a file system. @@ -7760,14 +7765,17 @@ prompt the user before killing them." :group 'convenience :version "26.1") -(defun save-buffers-kill-emacs (&optional arg) +(defun save-buffers-kill-emacs (&optional arg restart) "Offer to save each buffer, then kill this Emacs process. With prefix ARG, silently save all file-visiting buffers without asking. If there are active processes where `process-query-on-exit-flag' returns non-nil and `confirm-kill-processes' is non-nil, asks whether processes should be killed. + Runs the members of `kill-emacs-query-functions' in turn and stops -if any returns nil. If `confirm-kill-emacs' is non-nil, calls it." +if any returns nil. If `confirm-kill-emacs' is non-nil, calls it. + +If RESTART, restart Emacs after killing the current Emacs process." (interactive "P") ;; Don't use save-some-buffers-default-predicate, because we want ;; to ask about all the buffers before killing Emacs. @@ -7821,7 +7829,7 @@ if any returns nil. If `confirm-kill-emacs' is non-nil, calls it." (run-hook-with-args-until-failure 'kill-emacs-query-functions) (or (null confirm) (funcall confirm "Really exit Emacs? ")) - (kill-emacs)))) + (kill-emacs nil restart)))) (defun save-buffers-kill-terminal (&optional arg) "Offer to save each buffer, then kill the current connection. @@ -7836,6 +7844,16 @@ only these files will be asked to be saved." (if (frame-parameter nil 'client) (server-save-buffers-kill-terminal arg) (save-buffers-kill-emacs arg))) + +(defun restart-emacs () + "Kill the current Emacs process and start a new one. +This goes through the same shutdown procedure as +`save-buffers-kill-emacs', but instead of killing Emacs and +exiting, it re-executes Emacs (using the same command line +arguments as the running Emacs)." + (interactive) + (save-buffers-kill-emacs nil t)) + ;; We use /: as a prefix to "quote" a file name ;; so that magic file name handlers will not apply to it. diff --git a/lisp/finder.el b/lisp/finder.el index 899e8292962..a2a27ea061d 100644 --- a/lisp/finder.el +++ b/lisp/finder.el @@ -1,7 +1,6 @@ ;;; finder.el --- topic & keyword-based code finder -*- lexical-binding: t -*- -;; Copyright (C) 1992, 1997-1999, 2001-2022 Free Software Foundation, -;; Inc. +;; Copyright (C) 1992-2022 Free Software Foundation, Inc. ;; Author: Eric S. Raymond <esr@snark.thyrsus.com> ;; Created: 16 Jun 1992 @@ -76,20 +75,18 @@ "Association list of the standard \"Keywords:\" headers. Each element has the form (KEYWORD . DESCRIPTION).") -(defvar finder-mode-map - (let ((map (make-sparse-keymap))) - (define-key map " " 'finder-select) - (define-key map "f" 'finder-select) - (define-key map [follow-link] 'mouse-face) - (define-key map [mouse-2] 'finder-mouse-select) - (define-key map "\C-m" 'finder-select) - (define-key map "?" 'finder-summary) - (define-key map "n" 'next-line) - (define-key map "p" 'previous-line) - (define-key map "q" 'finder-exit) - (define-key map "d" 'finder-list-keywords) - map) - "Keymap used in `finder-mode'.") +(defvar-keymap finder-mode-map + :doc "Keymap used in `finder-mode'." + "SPC" #'finder-select + "f" #'finder-select + "<follow-link>" 'mouse-face + "<mouse-2>" #'finder-mouse-select + "C-m" #'finder-select + "?" #'finder-summary + "n" #'next-line + "p" #'previous-line + "q" #'finder-exit + "d" #'finder-list-keywords) (easy-menu-define finder-mode-menu finder-mode-map "Menu for `finder-mode'." diff --git a/lisp/foldout.el b/lisp/foldout.el index 4b192a7b6aa..e00fb40e3ca 100644 --- a/lisp/foldout.el +++ b/lisp/foldout.el @@ -473,7 +473,7 @@ What happens depends on the number of mouse clicks:- "Swallow intervening mouse events so we only get the final click-count. Signal an error if the final event isn't the same type as the first one." (let ((initial-event-type (event-basic-type event))) - (while (null (sit-for (/ double-click-time 1000.0) 'nodisplay)) + (while (null (sit-for (/ (mouse-double-click-time) 1000.0) 'nodisplay)) (setq event (read--potential-mouse-event))) (or (eq initial-event-type (event-basic-type event)) (error ""))) diff --git a/lisp/font-lock.el b/lisp/font-lock.el index 5034c98d26e..488874a1755 100644 --- a/lisp/font-lock.el +++ b/lisp/font-lock.el @@ -391,7 +391,7 @@ This can be an \"!\" or the \"n\" in \"ifndef\".") ;; Fontification variables: (defvar font-lock-keywords nil - "A list of the keywords to highlight. + "A list of keywords and corresponding font-lock highlighting rules. There are two kinds of values: user-level, and compiled. A user-level keywords list is what a major mode or the user would @@ -416,10 +416,10 @@ point, and set `match-data' appropriately if it succeeds; like `re-search-forward' would). MATCHER regexps can be generated via the function `regexp-opt'. -FORM is an expression, whose value should be a keyword element, -evaluated when the keyword is (first) used in a buffer. This -feature can be used to provide a keyword that can only be -generated when Font Lock mode is actually turned on. +FORM is an expression, whose value should be a keyword element +of one of the above forms, evaluated when the keyword is (first) +used in a buffer. This feature can be used to provide a keyword +that can only be generated when Font Lock mode is actually turned on. HIGHLIGHT should be either MATCH-HIGHLIGHT or MATCH-ANCHORED. diff --git a/lisp/frame.el b/lisp/frame.el index 7b19b8b5d32..49eabcf9786 100644 --- a/lisp/frame.el +++ b/lisp/frame.el @@ -1727,7 +1727,7 @@ to the selected frame. Storing information about resize operations is off by default. If you set the variable `frame-size-history' like this -(setq frame-size-history '(100)) +(setq frame-size-history \\='(100)) then Emacs will save information about the next 100 significant operations affecting any frame's size in that variable. This @@ -2960,6 +2960,12 @@ If the frame is in fullscreen state, don't change its state, but set the frame's `fullscreen-restore' parameter to `maximized', so the frame will be maximized after disabling fullscreen state. +If you wish to hide the title bar when the frame is maximized, you +can add something like the following to your init file: + + (add-hook \\='window-size-change-functions + #\\='frame-hide-title-bar-when-maximized) + Note that with some window managers you may have to set `frame-resize-pixelwise' to non-nil in order to make a frame appear truly maximized. In addition, you may have to set @@ -3075,6 +3081,13 @@ Offer NUMBER as default value, if it is a natural number." bidi-display-reordering bidi-inhibit-bpa)) +(defun frame-hide-title-bar-when-maximized (frame) + "Hide the title bar if FRAME is maximized. +If FRAME isn't maximized, show the title bar." + (set-frame-parameter + frame 'undecorated + (eq (alist-get 'fullscreen (frame-parameters frame)) 'maximized))) + (provide 'frame) ;;; frame.el ends here diff --git a/lisp/frameset.el b/lisp/frameset.el index 05884eed3a8..a589f7b5d96 100644 --- a/lisp/frameset.el +++ b/lisp/frameset.el @@ -448,6 +448,7 @@ DO NOT MODIFY. See `frameset-filter-alist' for a full description.") (defvar frameset-persistent-filter-alist (append '((background-color . frameset-filter-sanitize-color) + (bottom . frameset-filter-shelve-param) (buffer-list . :never) (buffer-predicate . :never) (buried-buffer-list . :never) @@ -464,13 +465,20 @@ DO NOT MODIFY. See `frameset-filter-alist' for a full description.") (frameset--text-pixel-height . :save) (frameset--text-pixel-width . :save) (fullscreen . frameset-filter-shelve-param) + (GUI:bottom . frameset-filter-unshelve-param) (GUI:font . frameset-filter-unshelve-param) (GUI:fullscreen . frameset-filter-unshelve-param) (GUI:height . frameset-filter-unshelve-param) + (GUI:left . frameset-filter-unshelve-param) + (GUI:right . frameset-filter-unshelve-param) + (GUI:top . frameset-filter-unshelve-param) (GUI:width . frameset-filter-unshelve-param) (height . frameset-filter-shelve-param) + (left . frameset-filter-shelve-param) (parent-frame . :never) (mouse-wheel-frame . :never) + (right . frameset-filter-shelve-param) + (top . frameset-filter-shelve-param) (tty . frameset-filter-tty-to-GUI) (tty-type . frameset-filter-tty-to-GUI) (width . frameset-filter-shelve-param) @@ -1010,13 +1018,15 @@ not be changed once the frame has been created. Internal use only." (cl-loop for param in '(left top width height border-width minibuffer) when (assq param parameters) collect it)) -(defun frameset--restore-frame (parameters window-state filters force-onscreen) +(defun frameset--restore-frame (parameters window-state filters force-onscreen + &optional dx dy) "Set up and return a frame according to its saved state. That means either reusing an existing frame or creating one anew. PARAMETERS is the frame's parameter alist; WINDOW-STATE is its window state. For the meaning of FILTERS and FORCE-ONSCREEN, see `frameset-restore'. Internal use only." (let* ((fullscreen (cdr (assq 'fullscreen parameters))) + (tty-to-GUI (frameset-switch-to-gui-p parameters)) (filtered-cfg (frameset-filter-params parameters filters nil)) (display (cdr (assq 'display filtered-cfg))) ;; post-filtering alt-cfg frame) @@ -1093,6 +1103,14 @@ Internal use only." (not (eq (frame-parameter frame 'visibility) 'icon))) (frameset-move-onscreen frame force-onscreen)) + ;; Frames saved on TTY shall be all considered visible when + ;; restoring on GUI display. Also, offset each new such frame + ;; relative to the previous one, to make it more visible. + (when tty-to-GUI + (push '(visibility . t) alt-cfg) + (when (and (numberp dx) (numberp dy)) + (push (cons 'left (+ (frame-parameter frame 'left) dx)) alt-cfg) + (push (cons 'top (+ (frame-parameter frame 'top) dy)) alt-cfg))) ;; Let's give the finishing touches (visibility, maximization). (when alt-cfg (modify-frame-parameters frame alt-cfg)) ;; Now restore window state. @@ -1216,7 +1234,9 @@ All keyword parameters default to nil." ((pred functionp) (cl-remove-if-not reuse-frames frames)) (_ - (error "Invalid arg :reuse-frames %s" reuse-frames))))) + (error "Invalid arg :reuse-frames %s" reuse-frames)))) + (dx 0) + (dy 0)) ;; Mark existing frames in the map; candidates to reuse are marked as :ignored; ;; they will be reassigned later, if chosen. @@ -1289,11 +1309,21 @@ All keyword parameters default to nil." (setq mb-window nil))) (when mb-window (push (cons 'minibuffer mb-window) frame-cfg)))))) + ;; Apply small offsets to each frame that came from + ;; a TTY-saved desktop, so that they don't obscure + ;; each other, but only if we don't have real frame + ;; position info from a GUI session in some, + ;; possibly distant, past. + (when (and (frameset-switch-to-gui-p frame-cfg) + (null (cdr (assq 'GUI:top frame-cfg))) + (null (cdr (assq 'GUI:left frame-cfg)))) + (setq dx (+ dx 20) + dy (+ dy 10))) ;; OK, we're ready at last to create (or reuse) a frame and ;; restore the window config. (setq frame (frameset--restore-frame frame-cfg window-cfg (or filters frameset-filter-alist) - force-onscreen)) + force-onscreen dx dy)) ;; Now reset any duplicate frameset--id (when (and duplicate (not (eq frame duplicate))) (set-frame-parameter duplicate 'frameset--id nil)) diff --git a/lisp/fringe.el b/lisp/fringe.el index 8c833f02429..1cfcce4542a 100644 --- a/lisp/fringe.el +++ b/lisp/fringe.el @@ -244,10 +244,18 @@ When used in a Lisp program, MODE should be one of these: nil (meaning the default width). - a single integer, which specifies the pixel widths of both fringes. + This command may round up the left and right width specifications to ensure that their sum is a multiple of the character width of a frame. It never rounds up a fringe width of 0. +Note that removing a right or left fringe (by setting the width +to zero) makes Emacs reserve one column of the window body to +display a line continuation marker. (This happens for both the +left and right fringe, since Emacs can display both left-to-right +and right-to-left text.) You can use `window-max-characters-per-line' +to check the effective width. + Fringe widths set by `set-window-fringes' override the default fringe widths set by this command. This command applies to all frames that exist and frames to be created in the future. If you diff --git a/lisp/gnus/deuglify.el b/lisp/gnus/deuglify.el index d2edfdf09f4..732c6062b8b 100644 --- a/lisp/gnus/deuglify.el +++ b/lisp/gnus/deuglify.el @@ -439,6 +439,7 @@ If NODISPLAY is non-nil, don't redisplay the article buffer." (unless nodisplay (gnus-outlook-display-article-buffer)) attrib-start)) +;;;###autoload (defun gnus-article-outlook-rearrange-citation (&optional nodisplay) "Repair broken citations. If NODISPLAY is non-nil, don't redisplay the article buffer." diff --git a/lisp/gnus/gmm-utils.el b/lisp/gnus/gmm-utils.el index 697ce01343a..fc18d8a1c51 100644 --- a/lisp/gnus/gmm-utils.el +++ b/lisp/gnus/gmm-utils.el @@ -134,47 +134,8 @@ ARGS are passed to `message'." (const :tag "No map") (plist :inline t :tag "Properties")))) -(define-widget 'gmm-tool-bar-zap-list 'lazy - "Tool bar zap list." - :tag "Tool bar zap list" - :type '(choice (const :tag "Zap all" t) - (const :tag "Keep all" nil) - (list - ;; :value - ;; Work around (bug in customize?), see - ;; <news:v9is48jrj1.fsf@marauder.physik.uni-ulm.de> - ;; (new-file open-file dired kill-buffer write-file - ;; print-buffer customize help) - (set :inline t - (const new-file) - (const open-file) - (const dired) - (const kill-buffer) - (const save-buffer) - (const write-file) - (const undo) - (const cut) - (const copy) - (const paste) - (const search-forward) - (const print-buffer) - (const customize) - (const help)) - (repeat :inline t - :tag "Other" - (symbol :tag "Icon item"))))) - -(defcustom gmm-tool-bar-style - (if (and (boundp 'tool-bar-mode) - tool-bar-mode - (not (memq (display-visual-class) - (list 'static-gray 'gray-scale - 'static-color 'pseudo-color)))) - 'gnome - 'retro) - "Preferred tool bar style." - :type '(choice (const :tag "GNOME style" gnome) - (const :tag "Retro look" retro))) +(defvar gmm-tool-bar-style 'gnome) +(make-obsolete-variable 'gmm-tool-bar-style nil "29.1") (defvar tool-bar-map) diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index 550f4e940a8..04d19e29a3a 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -983,66 +983,36 @@ simple manner." (gnus-run-hooks 'gnus-group-menu-hook))) - (defvar gnus-group-tool-bar-map nil) -(defun gnus-group-tool-bar-update (&optional symbol value) - "Update group buffer toolbar. -Setter function for custom variables." - (when symbol - (set-default symbol value)) - ;; (setq-default gnus-group-tool-bar-map nil) - ;; (use-local-map gnus-group-mode-map) - (when (gnus-alive-p) - (with-current-buffer gnus-group-buffer - (gnus-group-make-tool-bar t)))) - -(defcustom gnus-group-tool-bar (if (eq gmm-tool-bar-style 'gnome) - 'gnus-group-tool-bar-gnome - 'gnus-group-tool-bar-retro) - "Specifies the Gnus group tool bar. - -It can be either a list or a symbol referring to a list. See -`gmm-tool-bar-from-list' for the format of the list. The -default key map is `gnus-group-mode-map'. - -Pre-defined symbols include `gnus-group-tool-bar-gnome' and -`gnus-group-tool-bar-retro'." - :type '(choice (const :tag "GNOME style" gnus-group-tool-bar-gnome) - (const :tag "Retro look" gnus-group-tool-bar-retro) - (repeat :tag "User defined list" gmm-tool-bar-item) - (symbol)) - :version "23.1" ;; No Gnus - :initialize 'custom-initialize-default - :set 'gnus-group-tool-bar-update - :group 'gnus-group) - -(defcustom gnus-group-tool-bar-gnome +(defcustom gnus-group-tool-bar '((gnus-group-post-news "mail/compose") ;; Some useful agent icons? I don't use the agent so agent users should ;; suggest useful commands: - (gnus-agent-toggle-plugged "unplugged" t - :help "Gnus is currently unplugged. Click to work online." - :visible (and gnus-agent (not gnus-plugged))) - (gnus-agent-toggle-plugged "plugged" t - :help "Gnus is currently plugged. Click to work offline." - :visible (and gnus-agent gnus-plugged)) - ;; FIXME: gnus-agent-toggle-plugged (in gnus-agent-group-make-menu-bar) - ;; should have a better help text. - (gnus-group-send-queue "mail/outbox" t - :visible (and gnus-agent gnus-plugged) - :help "Send articles from the queue group") - (gnus-group-get-new-news "mail/inbox" nil - :visible (or (not gnus-agent) - gnus-plugged)) - ;; FIXME: gnus-*-read-group should have a better help text. - (gnus-topic-read-group "open" nil - :visible (and (boundp 'gnus-topic-mode) - gnus-topic-mode)) - (gnus-group-read-group "open" nil - :visible (not (and (boundp 'gnus-topic-mode) - gnus-topic-mode))) - ;; (gnus-group-find-new-groups "???" nil) + (gnus-agent-toggle-plugged + "unplugged" t + :help "Gnus is currently unplugged. Click to work online." + :visible (and gnus-agent (not gnus-plugged))) + (gnus-agent-toggle-plugged + "plugged" t + :help "Gnus is currently plugged. Click to work offline." + :visible (and gnus-agent gnus-plugged)) + (gnus-group-send-queue + "mail/outbox" t + :visible (and gnus-agent gnus-plugged) + :help "Send articles from the queue group") + (gnus-group-get-new-news + "mail/inbox" nil + :visible (or (not gnus-agent) + gnus-plugged)) + (gnus-topic-read-group + "open" nil + :visible (and (boundp 'gnus-topic-mode) + gnus-topic-mode)) + (gnus-group-read-group + "open" nil + :visible (not (and (boundp 'gnus-topic-mode) + gnus-topic-mode))) (gnus-group-save-newsrc "save") (gnus-group-describe-group "describe") (gnus-group-toggle-subscription-at-point "gnus/toggle-subscription") @@ -1051,44 +1021,22 @@ Pre-defined symbols include `gnus-group-tool-bar-gnome' and (gnus-group-exit "exit") (gmm-customize-mode "preferences" t :help "Edit mode preferences") (gnus-info-find-node "help")) - "List of functions for the group tool bar (GNOME style). - -See `gmm-tool-bar-from-list' for the format of the list." - :type '(repeat gmm-tool-bar-item) - :version "23.1" ;; No Gnus - :initialize 'custom-initialize-default - :set 'gnus-group-tool-bar-update - :group 'gnus-group) + "Specifies the Gnus group tool bar. -(defcustom gnus-group-tool-bar-retro - '((gnus-group-get-new-news "gnus/get-news") - (gnus-group-get-new-news-this-group "gnus/gnntg") - (gnus-group-catchup-current "gnus/catchup") - (gnus-group-describe-group "gnus/describe-group") - (gnus-group-subscribe "gnus/subscribe" t - :help "Subscribe to the current group") - (gnus-group-unsubscribe "gnus/unsubscribe" t - :help "Unsubscribe from the current group") - (gnus-group-exit "gnus/exit-gnus" gnus-group-mode-map)) - "List of functions for the group tool bar (retro look). - -See `gmm-tool-bar-from-list' for the format of the list." - :type '(repeat gmm-tool-bar-item) - :version "23.1" ;; No Gnus - :initialize 'custom-initialize-default - :set 'gnus-group-tool-bar-update +It can be either a list or a symbol referring to a list. See +`gmm-tool-bar-from-list' for the format of the list. The +default key map is `gnus-group-mode-map'." + :type '(choice (repeat :tag "User defined list" gmm-tool-bar-item) + (symbol)) + :version "29.1" :group 'gnus-group) -(defcustom gnus-group-tool-bar-zap-list t - "List of icon items from the global tool bar. -These items are not displayed in the Gnus group mode tool bar. - -See `gmm-tool-bar-from-list' for the format of the list." - :type 'gmm-tool-bar-zap-list - :version "23.1" ;; No Gnus - :initialize 'custom-initialize-default - :set 'gnus-group-tool-bar-update - :group 'gnus-group) +(defvar gnus-group-tool-bar-gnome nil) +(make-obsolete-variable 'gnus-group-tool-bar-gnome nil "29.1") +(defvar gnus-group-tool-bar-retro nil) +(make-obsolete-variable 'gnus-group-tool-bar-retro nil "29.1") +(defvar gnus-group-tool-bar-zap-list t) +(make-obsolete-variable 'gnus-group-tool-bar-zap-list nil "29.1") (defvar image-load-path) (defvar tool-bar-map) diff --git a/lisp/gnus/gnus-html.el b/lisp/gnus/gnus-html.el index 45f1e6099ea..87f3ee63623 100644 --- a/lisp/gnus/gnus-html.el +++ b/lisp/gnus/gnus-html.el @@ -40,14 +40,11 @@ (require 'help-fns) (require 'url-queue) -(defcustom gnus-html-image-cache-ttl (days-to-time 7) - "Time used to determine if we should use images from the cache." - :version "24.1" +(defcustom gnus-html-image-cache-ttl (time-convert (days-to-time 7) 'integer) + "Number of seconds used to determine if we should use images from the cache." + :version "29.1" :group 'gnus-art - ;; FIXME hardly the friendliest type. The allowed value is actually - ;; any time value, but we are assuming no-one cares about USEC and - ;; PSEC here. It would be better to eg make it a number of minutes. - :type '(list integer integer)) + :type 'number) (defcustom gnus-html-image-automatic-caching t "Whether automatically cache retrieve images." diff --git a/lisp/gnus/gnus-msg.el b/lisp/gnus/gnus-msg.el index f6ae028a104..17a87134be0 100644 --- a/lisp/gnus/gnus-msg.el +++ b/lisp/gnus/gnus-msg.el @@ -1571,8 +1571,9 @@ this is a reply." (when gcc (message-remove-header "gcc") (widen) - (setq groups (message-unquote-tokens - (message-tokenize-header gcc ",\n\t"))) + (setq groups (mapcar #'string-trim + (message-unquote-tokens + (message-tokenize-header gcc)))) ;; Copy the article over to some group(s). (while (setq group (pop groups)) (setq method (gnus-inews-group-method group)) diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el index 6c70257f42f..17724c3a514 100644 --- a/lisp/gnus/gnus-search.el +++ b/lisp/gnus/gnus-search.el @@ -2125,9 +2125,9 @@ Assume \"size\" key is equal to \"larger\"." (defun gnus-search-prepare-query (query-spec) "Accept a search query in raw format, and prepare it. QUERY-SPEC is an alist produced by functions such as -`gnus-group-make-search-group', and contains at least a 'query +`gnus-group-make-search-group', and contains at least a `query' key, and possibly some meta keys. This function extracts any -additional meta keys from the 'query string, and parses the +additional meta keys from the `query' string, and parses the remaining string, then adds all that to the top-level spec." (let ((query (alist-get 'query query-spec)) val) diff --git a/lisp/gnus/gnus-sum.el b/lisp/gnus/gnus-sum.el index 62efacfd6e2..a4f98c91573 100644 --- a/lisp/gnus/gnus-sum.el +++ b/lisp/gnus/gnus-sum.el @@ -2887,45 +2887,11 @@ gnus-summary-show-article-from-menu-as-charset-%s" cs)))) (defvar gnus-summary-tool-bar-map nil) -;; Note: The :set function in the `gnus-summary-tool-bar*' variables will only -;; affect _new_ message buffers. We might add a function that walks thru all -;; summary-mode buffers and force the update. -(defun gnus-summary-tool-bar-update (&optional symbol value) - "Update summary mode toolbar. -Setter function for custom variables." - (setq-default gnus-summary-tool-bar-map nil) - (when symbol - ;; When used as ":set" function: - (set-default symbol value)) - (when (gnus-buffer-live-p gnus-summary-buffer) - (with-current-buffer gnus-summary-buffer - (gnus-summary-make-tool-bar)))) - -(defcustom gnus-summary-tool-bar (if (eq gmm-tool-bar-style 'gnome) - 'gnus-summary-tool-bar-gnome - 'gnus-summary-tool-bar-retro) - "Specifies the Gnus summary tool bar. - -It can be either a list or a symbol referring to a list. See -`gmm-tool-bar-from-list' for the format of the list. The -default key map is `gnus-summary-mode-map'. - -Pre-defined symbols include `gnus-summary-tool-bar-gnome' and -`gnus-summary-tool-bar-retro'." - :type '(choice (const :tag "GNOME style" gnus-summary-tool-bar-gnome) - (const :tag "Retro look" gnus-summary-tool-bar-retro) - (repeat :tag "User defined list" gmm-tool-bar-item) - (symbol)) - :version "23.1" ;; No Gnus - :initialize 'custom-initialize-default - :set 'gnus-summary-tool-bar-update - :group 'gnus-summary) - -(defcustom gnus-summary-tool-bar-gnome +(defcustom gnus-summary-tool-bar '((gnus-summary-post-news "mail/compose" nil) - (gnus-summary-insert-new-articles "mail/inbox" nil - :visible (or (not gnus-agent) - gnus-plugged)) + (gnus-summary-insert-new-articles + "mail/inbox" nil + :visible (or (not gnus-agent) gnus-plugged)) (gnus-summary-reply-with-original "mail/reply") (gnus-summary-reply "mail/reply" nil :visible nil) (gnus-summary-followup-with-original "mail/reply-all") @@ -2935,17 +2901,10 @@ Pre-defined symbols include `gnus-summary-tool-bar-gnome' and (gnus-summary-search-article-forward "search" nil :visible nil) (gnus-summary-print-article "print") (gnus-summary-tick-article-forward "flag-followup" nil :visible nil) - ;; Some new commands that may need more suitable icons: (gnus-summary-save-newsrc "save" nil :visible nil) - ;; (gnus-summary-show-article "stock_message-display" nil :visible nil) (gnus-summary-prev-article "left-arrow") (gnus-summary-next-article "right-arrow") (gnus-summary-next-page "next-page") - ;; (gnus-summary-enter-digest-group "right_arrow" nil :visible nil) - ;; - ;; Maybe some sort-by-... could be added: - ;; (gnus-summary-sort-by-author "sort-a-z" nil :visible nil) - ;; (gnus-summary-sort-by-date "sort-1-9" nil :visible nil) (gnus-summary-mark-as-expirable "delete" nil :visible (gnus-check-backend-function 'request-expire-articles @@ -2959,64 +2918,25 @@ Pre-defined symbols include `gnus-summary-tool-bar-gnome' and "mail/not-spam" nil :visible (and (fboundp 'spam-group-spam-contents-p) (spam-group-spam-contents-p gnus-newsgroup-name))) - ;; (gnus-summary-exit "exit") (gmm-customize-mode "preferences" t :help "Edit mode preferences") (gnus-info-find-node "help")) - "List of functions for the summary tool bar (GNOME style). - -See `gmm-tool-bar-from-list' for the format of the list." - :type '(repeat gmm-tool-bar-item) - :version "23.1" ;; No Gnus - :initialize 'custom-initialize-default - :set 'gnus-summary-tool-bar-update - :group 'gnus-summary) + "Specifies the Gnus summary tool bar. -(defcustom gnus-summary-tool-bar-retro - '((gnus-summary-prev-unread-article "gnus/prev-ur") - (gnus-summary-next-unread-article "gnus/next-ur") - (gnus-summary-post-news "gnus/post") - (gnus-summary-followup-with-original "gnus/fuwo") - (gnus-summary-followup "gnus/followup") - (gnus-summary-reply-with-original "gnus/reply-wo") - (gnus-summary-reply "gnus/reply") - (gnus-summary-caesar-message "gnus/rot13") - (gnus-uu-decode-uu "gnus/uu-decode") - (gnus-summary-save-article-file "gnus/save-aif") - (gnus-summary-save-article "gnus/save-art") - (gnus-uu-post-news "gnus/uu-post") - (gnus-summary-catchup "gnus/catchup") - (gnus-summary-catchup-and-exit "gnus/cu-exit") - (gnus-summary-exit "gnus/exit-summ") - ;; Some new command that may need more suitable icons: - (gnus-summary-print-article "gnus/print" nil :visible nil) - (gnus-summary-mark-as-expirable "gnus/close" nil :visible nil) - (gnus-summary-save-newsrc "gnus/save" nil :visible nil) - ;; (gnus-summary-enter-digest-group "gnus/right_arrow" nil :visible nil) - (gnus-summary-search-article-forward "gnus/search" nil :visible nil) - ;; (gnus-summary-insert-new-articles "gnus/paste" nil :visible nil) - ;; (gnus-summary-toggle-threads "gnus/open" nil :visible nil) - ;; - (gnus-info-find-node "gnus/help" nil :visible nil)) - "List of functions for the summary tool bar (retro look). - -See `gmm-tool-bar-from-list' for the format of the list." - :type '(repeat gmm-tool-bar-item) - :version "23.1" ;; No Gnus - :initialize 'custom-initialize-default - :set 'gnus-summary-tool-bar-update +It can be either a list or a symbol referring to a list. See +`gmm-tool-bar-from-list' for the format of the list. The +default key map is `gnus-summary-mode-map'." + :type '(choice (repeat :tag "User defined list" gmm-tool-bar-item) + (symbol)) + :version "29.1" :group 'gnus-summary) -(defcustom gnus-summary-tool-bar-zap-list t - "List of icon items from the global tool bar. -These items are not displayed in the Gnus summary mode tool bar. - -See `gmm-tool-bar-from-list' for the format of the list." - :type 'gmm-tool-bar-zap-list - :version "23.1" ;; No Gnus - :initialize 'custom-initialize-default - :set 'gnus-summary-tool-bar-update - :group 'gnus-summary) +(defvar gnus-summary-tool-bar-gnome nil) +(make-obsolete-variable 'gnus-summary-tool-bar-gnome nil "29.1") +(defvar gnus-summary-tool-bar-retro nil) +(make-obsolete-variable 'gnus-summary-tool-bar-retro nil "29.1") +(defvar gnus-summary-tool-bar-zap-list t) +(make-obsolete-variable 'gnus-summary-tool-bar-zap-list nil "29.1") (defvar image-load-path) (defvar tool-bar-map) @@ -9447,7 +9367,7 @@ The 1st element is the button named by `gnus-collect-urls-primary-text'." (defun gnus-collect-urls-from-article () "Select the article and return the list of URLs in it. -See 'gnus-collect-urls'." +See `gnus-collect-urls'." (gnus-summary-select-article) (gnus-with-article-buffer (article-goto-body) diff --git a/lisp/gnus/gnus-topic.el b/lisp/gnus/gnus-topic.el index c079d889d98..fa942bee8e8 100644 --- a/lisp/gnus/gnus-topic.el +++ b/lisp/gnus/gnus-topic.el @@ -650,6 +650,7 @@ articles in the topic and its subtopics." (let* ((visible (if visiblep "" "...")) (level level) (name name) + (entries entries) (indentation (make-string (* gnus-topic-indent-level level) ? )) (total-number-of-articles unread) (number-of-groups (length entries)) @@ -677,7 +678,7 @@ articles in the topic and its subtopics." (defun gnus-topic-update-topics-containing-group (group) "Update all topics that have GROUP as a member." - (when (and (eq major-mode 'gnus-topic-mode) + (when (and (derived-mode-p 'gnus-group-mode) gnus-topic-mode) (save-excursion (let ((alist gnus-topic-alist)) @@ -693,7 +694,7 @@ articles in the topic and its subtopics." (defun gnus-topic-update-topic () "Update all parent topics to the current group." - (when (and (eq major-mode 'gnus-topic-mode) + (when (and (derived-mode-p 'gnus-group-mode) gnus-topic-mode) (let ((group (gnus-group-group-name)) (m (point-marker)) @@ -747,8 +748,8 @@ articles in the topic and its subtopics." (car type) (car gnus-group-list-mode) (cdr gnus-group-list-mode))) (all-groups (gnus-topic-find-groups - (car type) (car gnus-group-list-mode) - (cdr gnus-group-list-mode) nil t)) + (car type) (car gnus-group-list-mode) + (cdr gnus-group-list-mode) nil t)) entry) (while children (cl-incf unread (gnus-topic-unread (caar (pop children))))) @@ -787,8 +788,8 @@ articles in the topic and its subtopics." (car type) (car gnus-group-list-mode) (cdr gnus-group-list-mode))) (all-groups (gnus-topic-find-groups - (car type) (car gnus-group-list-mode) - (cdr gnus-group-list-mode) t)) + (car type) (car gnus-group-list-mode) + (cdr gnus-group-list-mode) nil t)) (parent (gnus-topic-parent-topic topic-name)) (all-entries entries) (unread 0) diff --git a/lisp/gnus/gnus-util.el b/lisp/gnus/gnus-util.el index 6150781fecc..218a4d242b2 100644 --- a/lisp/gnus/gnus-util.el +++ b/lisp/gnus/gnus-util.el @@ -562,7 +562,7 @@ If N, return the Nth ancestor instead." buffer)) (define-obsolete-function-alias 'gnus-buffer-exists-p - 'gnus-buffer-live-p "27.1") + #'gnus-buffer-live-p "27.1") (defun gnus-horizontal-recenter () "Recenter the current buffer horizontally." @@ -680,7 +680,7 @@ yield \"nnimap:yxa\"." (defun gnus-turn-off-edit-menu (type) "Turn off edit menu in `gnus-TYPE-mode-map'." (define-key (symbol-value (intern (format "gnus-%s-mode-map" type))) - [menu-bar edit] 'undefined)) + [menu-bar edit] #'undefined)) (defvar print-string-length) @@ -954,9 +954,9 @@ ARG is passed to the first function." (with-current-buffer gnus-group-buffer (eq major-mode 'gnus-group-mode)))) -(define-obsolete-function-alias 'gnus-remove-if 'seq-remove "27.1") +(define-obsolete-function-alias 'gnus-remove-if #'seq-remove "27.1") -(define-obsolete-function-alias 'gnus-remove-if-not 'seq-filter "27.1") +(define-obsolete-function-alias 'gnus-remove-if-not #'seq-filter "27.1") (defun gnus-grep-in-list (word list) "Find if a WORD matches any regular expression in the given LIST." @@ -1091,9 +1091,10 @@ ARG is passed to the first function." (defun gnus-byte-compile (form) "Byte-compile FORM if `gnus-use-byte-compile' is non-nil." (if gnus-use-byte-compile - (let ((byte-compile-warnings '(unresolved callargs redefine))) + (let ((byte-compile-warnings '(unresolved callargs redefine)) + (lexical-binding t)) (byte-compile form)) - form)) + (eval form t))) (defun gnus-remassoc (key alist) "Delete by side effect any elements of LIST whose car is `equal' to KEY. diff --git a/lisp/gnus/gnus.el b/lisp/gnus/gnus.el index 0daecf7df54..1f673771fa1 100644 --- a/lisp/gnus/gnus.el +++ b/lisp/gnus/gnus.el @@ -662,12 +662,11 @@ be used directly.") (gnus-prune-buffers) (cl-pushnew (current-buffer) gnus-buffers)) -(defmacro gnus-kill-buffer (buffer) +(defun gnus-kill-buffer (buffer) "Kill BUFFER and remove from the list of Gnus buffers." - `(let ((buf ,buffer)) - (when (gnus-buffer-live-p buf) - (kill-buffer buf) - (gnus-prune-buffers)))) + (when (gnus-buffer-live-p buffer) + (kill-buffer buffer) + (gnus-prune-buffers))) (defun gnus-buffers () "Return a list of live Gnus buffers." @@ -2529,7 +2528,8 @@ are always t.") ("nnmail" nnmail-split-fancy nnmail-article-group) ("nnvirtual" nnvirtual-catchup-group nnvirtual-convert-headers) ("gnus-xmas" gnus-xmas-splash) - ("score-mode" :interactive t gnus-score-mode gnus-score-edit-all-score) + ("score-mode" :interactive t gnus-score-mode) + ("gnus-score" :interactive t gnus-score-edit-all-score) ("gnus-mh" gnus-summary-save-article-folder gnus-Folder-save-name gnus-folder-save-name) ("gnus-mh" :interactive (gnus-summary-mode) gnus-summary-save-in-folder) diff --git a/lisp/gnus/message.el b/lisp/gnus/message.el index 30734b8f1ad..e7dc089a3c6 100644 --- a/lisp/gnus/message.el +++ b/lisp/gnus/message.el @@ -8167,39 +8167,7 @@ which specify the range to operate on." ;; Support for toolbar (defvar tool-bar-mode) -;; Note: The :set function in the `message-tool-bar*' variables will only -;; affect _new_ message buffers. We might add a function that walks thru all -;; message-mode buffers and force the update. -(defun message-tool-bar-update (&optional symbol value) - "Update message mode toolbar. -Setter function for custom variables." - (setq-default message-tool-bar-map nil) - (when symbol - ;; When used as ":set" function: - (set-default symbol value))) - -(defcustom message-tool-bar (if (eq gmm-tool-bar-style 'gnome) - 'message-tool-bar-gnome - 'message-tool-bar-retro) - "Specifies the message mode tool bar. - -It can be either a list or a symbol referring to a list. See -`gmm-tool-bar-from-list' for the format of the list. The -default key map is `message-mode-map'. - -Pre-defined symbols include `message-tool-bar-gnome' and -`message-tool-bar-retro'." - :type '(repeat gmm-tool-bar-list-item) - :type '(choice (const :tag "GNOME style" message-tool-bar-gnome) - (const :tag "Retro look" message-tool-bar-retro) - (repeat :tag "User defined list" gmm-tool-bar-item) - (symbol)) - :version "23.1" ;; No Gnus - :initialize #'custom-initialize-default - :set #'message-tool-bar-update - :group 'message) - -(defcustom message-tool-bar-gnome +(defcustom message-tool-bar '((ispell-message "spell" nil :vert-only t :visible (not flyspell-mode)) @@ -8215,47 +8183,23 @@ Pre-defined symbols include `message-tool-bar-gnome' and (message-insert-importance-high "important" nil :visible nil) (message-insert-importance-low "unimportant" nil :visible nil) (message-insert-disposition-notification-to "receipt" nil :visible nil)) - "List of items for the message tool bar (GNOME style). - -See `gmm-tool-bar-from-list' for details on the format of the list." - :type '(repeat gmm-tool-bar-item) - :version "23.1" ;; No Gnus - :initialize #'custom-initialize-default - :set #'message-tool-bar-update - :group 'message) + "Specifies the message mode tool bar. -(defcustom message-tool-bar-retro - '(;; Old Emacs 21 icon for consistency. - (message-send-and-exit "mail/send") - (message-kill-buffer "close") - (message-dont-send "cancel") - (mml-attach-file "attach" mml-mode-map) - (ispell-message "spell") - (mml-preview "preview" mml-mode-map) - (message-insert-importance-high "gnus/important") - (message-insert-importance-low "gnus/unimportant") - (message-insert-disposition-notification-to "gnus/receipt")) - "List of items for the message tool bar (retro style). - -See `gmm-tool-bar-from-list' for details on the format of the list." - :type '(repeat gmm-tool-bar-item) - :version "23.1" ;; No Gnus - :initialize #'custom-initialize-default - :set #'message-tool-bar-update +It can be either a list or a symbol referring to a list. See +`gmm-tool-bar-from-list' for the format of the list. The +default key map is `message-mode-map'." + :type '(repeat gmm-tool-bar-list-item) + :type '(choice (repeat :tag "User defined list" gmm-tool-bar-item) + (symbol)) + :version "29.1" :group 'message) -(defcustom message-tool-bar-zap-list - '(new-file open-file dired kill-buffer write-file - print-buffer customize help) - "List of icon items from the global tool bar. -These items are not displayed on the message mode tool bar. - -See `gmm-tool-bar-from-list' for the format of the list." - :type 'gmm-tool-bar-zap-list - :version "23.1" ;; No Gnus - :initialize #'custom-initialize-default - :set #'message-tool-bar-update - :group 'message) +(defvar message-tool-bar-gnome nil) +(make-obsolete-variable 'message-tool-bar-gnome nil "29.1") +(defvar message-tool-bar-retro nil) +(make-obsolete-variable 'message-tool-bar-gnome nil "29.1") +(defvar message-tool-bar-zap-list t) +(make-obsolete-variable 'message-tool-bar-zap-list nil "29.1") (defvar image-load-path) (declare-function image-load-path-for-library "image" @@ -9008,7 +8952,7 @@ used to take the screenshot." This is meant to be used for MIME handlers: Setting the handler for \"x-scheme-handler/mailto;\" to \"emacs -f message-mailto %u\" will then start up Emacs ready to compose mail. For emacsclient use - emacsclient -e '(message-mailto \"%u\")'" + emacsclient -e \\='(message-mailto \"%u\")'" (interactive) ;; <a href="mailto:someone@example.com?subject=This%20is%20the%20subject&cc=someone_else@example.com&body=This%20is%20the%20body">Send email</a> (message-mail) diff --git a/lisp/gnus/mm-bodies.el b/lisp/gnus/mm-bodies.el index 956449dac14..9045966df5a 100644 --- a/lisp/gnus/mm-bodies.el +++ b/lisp/gnus/mm-bodies.el @@ -191,19 +191,21 @@ If TYPE is `text/plain' CRLF->LF translation may occur." ((eq encoding 'base64) (base64-decode-region (point-min) - ;; Some mailers insert whitespace - ;; junk at the end which - ;; base64-decode-region dislikes. - ;; Also remove possible junk which could - ;; have been added by mailing list software. (save-excursion + ;; Some mailers insert whitespace junk at the end which + ;; base64-decode-region dislikes. (goto-char (point-min)) (while (re-search-forward "^[\t ]*\r?\n" nil t) (delete-region (match-beginning 0) (match-end 0))) + ;; Also ignore junk which could have been added by + ;; mailing list software by finding the final line with + ;; base64 text. (goto-char (point-max)) - (when (re-search-backward "^[\t ]*[A-Za-z0-9+/]+=*[\t ]*$" - nil t) - (forward-line)) + (beginning-of-line) + (while (and (not (mm-base64-line-p)) + (not (bobp))) + (forward-line -1)) + (forward-line 1) (point)))) ((memq encoding '(nil 7bit 8bit binary)) ;; Do nothing. @@ -236,6 +238,20 @@ If TYPE is `text/plain' CRLF->LF translation may occur." (while (search-forward "\r\n" nil t) (replace-match "\n" t t))))) +(defun mm-base64-line-p () + "Say whether the current line is base64." + ;; This is coded in this way to avoid using regexps that may + ;; overflow -- a base64 line may be megabytes long. + (save-excursion + (beginning-of-line) + (skip-chars-forward " \t") + (and (looking-at "[A-Za-z0-9+/]\\{3\\}") + (progn + (skip-chars-forward "A-Za-z0-9+/") + (skip-chars-forward "=") + (skip-chars-forward " \t") + (eolp))))) + (defun mm-decode-body (charset &optional encoding type) "Decode the current article that has been encoded with ENCODING to CHARSET. ENCODING is a MIME content transfer encoding. diff --git a/lisp/gnus/mm-encode.el b/lisp/gnus/mm-encode.el index ead3bae219d..39b1ad1f3b9 100644 --- a/lisp/gnus/mm-encode.el +++ b/lisp/gnus/mm-encode.el @@ -99,7 +99,7 @@ This variable should never be set directly, but bound before a call to ;;;###autoload (define-obsolete-function-alias 'mm-default-file-encoding - #'mm-default-file-type "future") ;Old bad name. + #'mm-default-file-type "28.1") ;Old bad name. ;;;###autoload (defun mm-default-file-type (file) "Return a default content type for FILE." diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el index 5a526025061..093e582ea7a 100644 --- a/lisp/gnus/mml.el +++ b/lisp/gnus/mml.el @@ -500,7 +500,8 @@ type detected." (when (and (consp (car cont)) (= (length cont) 1) content-type) - (setcdr (assq 'type (cdr (car cont))) content-type)) + (when-let ((spec (assq 'type (cdr (car cont))))) + (setcdr spec content-type))) (when (fboundp 'libxml-parse-html-region) (setq cont (mapcar #'mml-expand-all-html-into-multipart-related cont))) (prog1 diff --git a/lisp/gnus/nnmairix.el b/lisp/gnus/nnmairix.el index 4e8e329f983..8c811b0c6c0 100644 --- a/lisp/gnus/nnmairix.el +++ b/lisp/gnus/nnmairix.el @@ -333,7 +333,7 @@ this might lead to problems, especially when used with marks propagation." (defvar nnmairix-widget-other '(threads flags) "Other editable mairix commands when using customization widgets. -Currently there are 'threads and 'flags.") +Currently there are `threads' and `flags'.") (defvar nnmairix-interactive-query-parameters '((?f "from" "f" "From") (?t "to" "t" "To") (?c "to" "tc" "To or Cc") diff --git a/lisp/gnus/nnselect.el b/lisp/gnus/nnselect.el index 89ddd608979..cdbfa0b5910 100644 --- a/lisp/gnus/nnselect.el +++ b/lisp/gnus/nnselect.el @@ -269,8 +269,8 @@ If this variable is nil, or if the provided function returns nil, (defun nnselect-generate-artlist (group &optional specs) "Generate the artlist for GROUP using SPECS. -SPECS should be an alist including an 'nnselect-function and an -'nnselect-args. The former applied to the latter should create +SPECS should be an alist including an `nnselect-function' and an +`nnselect-args'. The former applied to the latter should create the artlist. If SPECS is nil retrieve the specs from the group parameters." (let* ((specs diff --git a/lisp/gnus/nntp.el b/lisp/gnus/nntp.el index 0dcff9743ad..f047c832931 100644 --- a/lisp/gnus/nntp.el +++ b/lisp/gnus/nntp.el @@ -1225,6 +1225,7 @@ If SEND-IF-FORCE, only send authinfo to the server if the (generate-new-buffer (format " *server %s %s %s*" nntp-address nntp-port-number buffer)) + (gnus-add-buffer) (mm-disable-multibyte) (setq-local after-change-functions nil nntp-process-wait-for nil diff --git a/lisp/gnus/smime.el b/lisp/gnus/smime.el index ac1e0810417..87b5551d31c 100644 --- a/lisp/gnus/smime.el +++ b/lisp/gnus/smime.el @@ -119,7 +119,7 @@ ;;; Code: (require 'dig) - +(require 'gnutls) (require 'password-cache) (eval-when-compile (require 'cl-lib)) @@ -149,10 +149,11 @@ certificate." :type '(choice (const :tag "none" nil) directory)) -(defcustom smime-CA-file nil - "Files containing certificates for CAs you trust. -File should contain certificates in PEM format." - :version "22.1" +(defcustom smime-CA-file (car (gnutls-trustfiles)) + "File containing certificates for CAs you trust. +The file should contain certificates in PEM format. By default, +this is initialized from the `gnutls-trusfiles' variable." + :version "29.1" :type '(choice (const :tag "none" nil) file)) diff --git a/lisp/gnus/spam.el b/lisp/gnus/spam.el index 297576288bb..5af29c0a246 100644 --- a/lisp/gnus/spam.el +++ b/lisp/gnus/spam.el @@ -852,7 +852,7 @@ The value nil means that the check does not yield a decision, and so, that further checks are needed. The value t means that the message is definitely not spam, and that further spam checks should be inhibited. Otherwise, a mailgroup name or the symbol -'spam (depending on `spam-split-symbolic-return') is returned where +`spam' (depending on `spam-split-symbolic-return') is returned where the mail should go, and further checks are also inhibited. The usual mailgroup name is the value of `spam-split-group', meaning that the message is definitely a spam." diff --git a/lisp/help-at-pt.el b/lisp/help-at-pt.el index c5a9a93482c..1a6d374db09 100644 --- a/lisp/help-at-pt.el +++ b/lisp/help-at-pt.el @@ -81,25 +81,37 @@ If this produces no string either, return nil." (echo (help-at-pt-string))) (if (and kbd (not (eq kbd t))) kbd echo))) +(declare-function widget-describe "wid-edit" (&optional widget-or-pos)) +(declare-function widget-at "wid-edit" (&optional pos)) + ;;;###autoload -(defun display-local-help (&optional arg) +(defun display-local-help (&optional inhibit-warning describe-button) "Display local help in the echo area. -This displays a short help message, namely the string produced by -the `kbd-help' property at point. If `kbd-help' does not produce -a string, but the `help-echo' property does, then that string is -printed instead. +This command, by default, displays a short help message, namely +the string produced by the `kbd-help' property at point. If +`kbd-help' does not produce a string, but the `help-echo' +property does, then that string is printed instead. The string is passed through `substitute-command-keys' before it is displayed. -A numeric argument ARG prevents display of a message in case -there is no help. While ARG can be used interactively, it is -mainly meant for use from Lisp." - (interactive "P") +If INHIBIT-WARNING is non-nil, this prevents display of a message +in case there is no help. + +If DESCRIBE-BUTTON in non-nil (interactively, the prefix arg), and +there's a button/widget at point, pop a buffer describing that +button/widget instead." + (interactive (list nil current-prefix-arg)) (let ((help (help-at-pt-kbd-string))) - (if help - (message "%s" (substitute-command-keys help)) - (if (not arg) (message "No local help at point"))))) + (cond + ((and describe-button (button-at (point))) + (button-describe)) + ((and describe-button (widget-at (point))) + (widget-describe)) + (help + (message "%s" (substitute-command-keys help))) + ((not inhibit-warning) + (message "No local help at point"))))) (defvar help-at-pt-timer nil "Non-nil means that a timer is set that checks for local help. diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 80d7d5cb028..0cb2c6d5d77 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -133,6 +133,14 @@ with the current prefix. The files are chosen according to :group 'help :version "26.3") +(defcustom help-enable-variable-value-editing nil + "If non-nil, allow editing values in *Help* buffers. +Values that aren't readable by the Emacs Lisp reader can't be +edited even if this option is enabled." + :type 'boolean + :group 'help + :version "29.1") + (defcustom help-enable-symbol-autoload nil "Perform autoload if docs are missing from autoload objects." :type 'boolean @@ -557,13 +565,10 @@ the C sources, too." (insert "\n")) (when menus (let ((start (point))) - (insert (concat "It can " - (and keys "also ") - "be invoked from the menu: ")) - ;; FIXME: Should insert menu names instead of key - ;; binding names. - (help-fns--insert-bindings menus) - (insert ".") + (help-fns--insert-menu-bindings + menus + (concat "It can " (and keys "also ") + "be invoked from the menu: ")) (fill-region-as-paragraph start (point)))) (ensure-empty-lines))))))) @@ -576,6 +581,38 @@ the C sources, too." (insert (help--key-description-fontified key))) keys)) +(defun help-fns--insert-menu-bindings (menus heading) + (seq-do-indexed + (lambda (menu i) + (insert + (cond ((zerop i) "") + ((= i (1- (length menus))) " and ") + (t ", "))) + (let ((map (lookup-key global-map (seq-take menu 1))) + (start (point))) + (seq-do-indexed + (lambda (entry level) + (when (symbolp map) + (setq map (symbol-function map))) + (when-let ((elem (assq entry (cdr map)))) + (when heading + (insert heading) + (setq heading nil start (point))) + (when (> level 0) + (insert + (if (char-displayable-p ?→) + " → " + " => "))) + (if (eq (nth 1 elem) 'menu-item) + (progn + (insert (nth 2 elem)) + (setq map (cadddr elem))) + (insert (nth 1 elem)) + (setq map (cddr elem))))) + (cdr (seq-into menu 'list))) + (put-text-property start (point) 'face 'help-key-binding))) + menus)) + (defun help-fns--compiler-macro (function) (let ((handler (function-get function 'compiler-macro))) (when handler @@ -1167,10 +1204,11 @@ it is displayed along with the global value." (let ((rep (let ((print-quoted t) (print-circle t)) - (cl-prin1-to-string val)))) - (if (and (symbolp val) (not (booleanp val))) + (cl-prin1-to-string val)))) + (if (and (symbolp val) (not (booleanp val))) (format-message "`%s'" rep) - rep)))) + rep))) + (start (point))) (if (< (+ (length print-rep) (point) (- line-beg)) 68) (insert " " print-rep) (terpri) @@ -1185,6 +1223,8 @@ it is displayed along with the global value." (insert-buffer-substring pp-buffer))))) ;; Remove trailing newline. (and (= (char-before) ?\n) (delete-char -1))) + (help-fns--editable-variable start (point) + variable val buffer) (let* ((sv (get variable 'standard-value)) (origval (and (consp sv) (condition-case nil @@ -1204,6 +1244,8 @@ it is displayed along with the global value." (save-restriction (narrow-to-region from (point)) (save-excursion (pp-buffer))) + (help-fns--editable-variable from (point) + variable origval buffer) (if (< (point) (+ from 20)) (delete-region (1- from) from))))))) (terpri) @@ -1236,7 +1278,9 @@ it is displayed along with the global value." ;; See previous comment for this function. ;; (help-xref-on-pp from (point)) (if (< (point) (+ from 20)) - (delete-region (1- from) from))))))) + (delete-region (1- from) from)) + (help-fns--editable-variable + from (point) variable global-val buffer)))))) (terpri)) ;; If the value is large, move it to the end. @@ -1286,6 +1330,66 @@ it is displayed along with the global value." ;; Return the text we displayed. (buffer-string)))))))) +(defun help-fns--editable-variable (start end variable value buffer) + (when (and (readablep value) + (or (not (symbolp value)) + (and (not (and (symbolp value) (boundp value))) + (not (and (symbolp value) (fboundp value))))) + help-enable-variable-value-editing) + (add-text-properties + start end + (list 'help-echo "`e' to edit the value" + 'help-fns--edit-variable (list variable value buffer + (current-buffer)) + 'keymap (define-keymap + "e" #'help-fns-edit-variable))))) + +(defvar help-fns--edit-variable) + +(put 'help-fns-edit-variable 'disabled t) +(defun help-fns-edit-variable () + "Edit the variable under point." + (interactive) + (declare (completion ignore)) + (let ((var (get-text-property (point) 'help-fns--edit-variable))) + (unless var + (error "No variable under point")) + (pop-to-buffer-same-window (format "*edit %s*" (nth 0 var))) + (prin1 (nth 1 var) (current-buffer)) + (pp-buffer) + (goto-char (point-min)) + (insert (format ";; Edit the `%s' variable.\n" (nth 0 var)) + ";; C-c C-c to update the value and exit.\n\n") + (help-fns--edit-value-mode) + (setq-local help-fns--edit-variable var))) + +(defvar-keymap help-fns--edit-value-mode-map + "C-c C-c" #'help-fns-edit-mode-done) + +(define-derived-mode help-fns--edit-value-mode emacs-lisp-mode "Elisp" + :interactive nil) + +(defun help-fns-edit-mode-done (&optional kill) + "Update the value of the variable and kill the buffer. +If KILL (the prefix), don't update the value, but just kill the +current buffer." + (interactive "P" help-fns--edit-value-mode) + (unless help-fns--edit-variable + (error "Invalid buffer")) + (goto-char (point-min)) + (cl-destructuring-bind (variable _ buffer help-buffer) + help-fns--edit-variable + (unless (buffer-live-p buffer) + (error "Original buffer is gone; can't update")) + (unless kill + (let ((value (read (current-buffer)))) + (with-current-buffer buffer + (set variable value)))) + (kill-buffer (current-buffer)) + (when (buffer-live-p help-buffer) + (with-current-buffer help-buffer + (revert-buffer))))) + (defun help-fns--run-describe-functions (functions &rest args) (with-current-buffer standard-output (unless (bolp) @@ -1878,107 +1982,96 @@ whose documentation describes the minor mode. If called from Lisp with a non-nil BUFFER argument, display documentation for the major and minor modes of that buffer." (interactive "@") - (let ((help-buffer-under-preparation t)) - (unless buffer (setq buffer (current-buffer))) + (unless buffer + (setq buffer (current-buffer))) + (let ((help-buffer-under-preparation t) + (local-minors (buffer-local-value 'local-minor-modes buffer))) (help-setup-xref (list #'describe-mode buffer) (called-interactively-p 'interactive)) ;; For the sake of help-do-xref and help-xref-go-back, ;; don't switch buffers before calling `help-buffer'. (with-help-window (help-buffer) - (with-current-buffer buffer - (let (minors) - ;; Older packages do not register in minor-mode-list but only in - ;; minor-mode-alist. - (dolist (x minor-mode-alist) - (setq x (car x)) - (unless (memq x minor-mode-list) - (push x minor-mode-list))) - ;; Find enabled minor mode we will want to mention. - (dolist (mode minor-mode-list) - ;; Document a minor mode if it is listed in minor-mode-alist, - ;; non-nil, and has a function definition. - (let ((fmode (or (get mode :minor-mode-function) mode))) - (and (boundp mode) (symbol-value mode) - (fboundp fmode) - (let ((pretty-minor-mode - (if (string-match "\\(\\(-minor\\)?-mode\\)?\\'" - (symbol-name fmode)) - (capitalize - (substring (symbol-name fmode) - 0 (match-beginning 0))) - fmode))) - (push (list fmode pretty-minor-mode - (format-mode-line (assq mode minor-mode-alist))) - minors))))) - ;; Narrowing is not a minor mode, but its indicator is part of - ;; mode-line-modes. - (when (buffer-narrowed-p) - (push '(narrow-to-region "Narrow" " Narrow") minors)) - (setq minors - (sort minors - (lambda (a b) (string-lessp (cadr a) (cadr b))))) - (when minors - (princ "Enabled minor modes:\n") - (make-local-variable 'help-button-cache) - (with-current-buffer standard-output - (dolist (mode minors) - (let ((mode-function (nth 0 mode)) - (pretty-minor-mode (nth 1 mode)) - (indicator (nth 2 mode))) - (save-excursion - (goto-char (point-max)) - (princ "\n\f\n") - (push (point-marker) help-button-cache) - ;; Document the minor modes fully. - (insert-text-button - pretty-minor-mode 'type 'help-function - 'help-args (list mode-function) - 'button '(t)) - (princ (format " minor mode (%s):\n" - (if (zerop (length indicator)) - "no indicator" - (format "indicator%s" - indicator)))) - (princ (help-split-fundoc (documentation mode-function) - nil 'doc))) - (insert-button pretty-minor-mode - 'action (car help-button-cache) - 'follow-link t - 'help-echo "mouse-2, RET: show full information") - (newline))) - (forward-line -1) - (fill-paragraph nil) - (forward-line 1)) - - (princ "\n(Information about these minor modes follows the major mode info.)\n\n")) - ;; Document the major mode. - (let ((mode mode-name)) - (with-current-buffer standard-output - (let ((start (point))) - (insert (format-mode-line mode nil nil buffer)) - (add-text-properties start (point) '(face bold))))) - (princ " mode") - (let* ((mode major-mode) - (file-name (find-lisp-object-file-name mode nil))) - (if (not file-name) - (setq help-mode--current-data (list :symbol mode)) - (princ (format-message " defined in `%s'" - (help-fns-short-filename file-name))) - ;; Make a hyperlink to the library. - (with-current-buffer standard-output - (save-excursion - (re-search-backward (substitute-command-keys "`\\([^`']+\\)'") - nil t) - (setq help-mode--current-data (list :symbol mode - :file file-name)) - (help-xref-button 1 'help-function-def mode file-name))))) - (let ((fundoc (help-split-fundoc (documentation major-mode) nil 'doc))) - (with-current-buffer standard-output - (insert ":\n") - (insert fundoc) - (insert (help-fns--list-local-commands)))))))) - ;; For the sake of IELM and maybe others - nil) + (with-current-buffer (help-buffer) + ;; Add the local minor modes at the start. + (when local-minors + (insert (format "Minor mode%s enabled in this buffer:" + (if (length> local-minors 1) + "s" ""))) + (describe-mode--minor-modes local-minors)) + + ;; Document the major mode. + (let ((major (buffer-local-value 'major-mode buffer))) + (insert "The major mode is " + (buttonize + (propertize (format-mode-line + (buffer-local-value 'mode-name buffer) + nil nil buffer) + 'face 'bold) + (lambda (_) + (describe-function major)))) + (insert " mode") + (when-let ((file-name (find-lisp-object-file-name major nil))) + (insert (format " defined in %s:\n\n" + (buttonize + (help-fns-short-filename file-name) + (lambda (_) + (help-function-def--button-function + major file-name)))))) + (insert (help-split-fundoc (documentation major) nil 'doc) + (with-current-buffer buffer + (help-fns--list-local-commands))) + (ensure-empty-lines 1) + + ;; Insert the global minor modes after the major mode. + (when global-minor-modes + (insert (format "Global minor mode%s enabled:" + (if (length> global-minor-modes 1) + "s" ""))) + (describe-mode--minor-modes global-minor-modes) + (when (re-search-forward "^\f") + (beginning-of-line) + (ensure-empty-lines 1))) + ;; For the sake of IELM and maybe others + nil))))) + +(defun describe-mode--minor-modes (modes) + (dolist (mode (seq-sort #'string< modes)) + (let ((pretty-minor-mode + (capitalize + (replace-regexp-in-string + "\\(\\(-minor\\)?-mode\\)?\\'" "" + (symbol-name mode))))) + (insert + " " + (buttonize + pretty-minor-mode + (lambda (mode) + (goto-char (point-min)) + (text-property-search-forward + 'help-minor-mode mode t) + (beginning-of-line)) + mode)) + (save-excursion + (goto-char (point-max)) + (insert "\n\n\f\n") + ;; Document the minor modes fully. + (insert (buttonize + (propertize pretty-minor-mode 'help-minor-mode mode) + (lambda (mode) + (describe-function mode)) + mode)) + (let ((indicator + (format-mode-line (assq mode minor-mode-alist)))) + (insert (format " minor mode (%s):\n" + (if (zerop (length indicator)) + "no indicator" + (format "indicator%s" + indicator))))) + (insert (help-split-fundoc (documentation mode) nil 'doc))))) + (forward-line -1) + (fill-paragraph nil) + (forward-paragraph 1) + (ensure-empty-lines 1)) (defun help-fns--list-local-commands () (let ((functions nil)) diff --git a/lisp/help-mode.el b/lisp/help-mode.el index d1b9357f3c9..94bd5911311 100644 --- a/lisp/help-mode.el +++ b/lisp/help-mode.el @@ -268,7 +268,9 @@ The format is (FUNCTION ARGS...).") (let* ((location (find-function-search-for-symbol fun type file)) (position (cdr location))) - (pop-to-buffer (car location)) + (if help-window-keep-selected + (pop-to-buffer-same-window (car location)) + (pop-to-buffer (car location))) (run-hooks 'find-function-after-hook) (if position (progn @@ -294,7 +296,10 @@ The format is (FUNCTION ARGS...).") (setq file (locate-library file t)) (if (and file (file-readable-p file)) (progn - (pop-to-buffer (find-file-noselect file)) + (if help-window-keep-selected + (pop-to-buffer-same-window + (find-file-noselect file)) + (pop-to-buffer (find-file-noselect file))) (widen) (goto-char (point-min)) (if (re-search-forward @@ -313,7 +318,9 @@ The format is (FUNCTION ARGS...).") (setq file (help-C-file-name var 'var))) (let* ((location (find-variable-noselect var file)) (position (cdr location))) - (pop-to-buffer (car location)) + (if help-window-keep-selected + (pop-to-buffer-same-window (car location)) + (pop-to-buffer (car location))) (run-hooks 'find-function-after-hook) (if position (progn @@ -334,7 +341,9 @@ The format is (FUNCTION ARGS...).") (let* ((location (find-function-search-for-symbol fun 'defface file)) (position (cdr location))) - (pop-to-buffer (car location)) + (if help-window-keep-selected + (pop-to-buffer-same-window (car location)) + (pop-to-buffer (car location))) (if position (progn ;; Widen the buffer if necessary to go to this position. @@ -376,7 +385,9 @@ The format is (FUNCTION ARGS...).") :supertype 'help-xref 'help-function (lambda (file pos) - (view-buffer-other-window (find-file-noselect file)) + (if help-window-keep-selected + (view-buffer (find-file-noselect file)) + (view-buffer-other-window (find-file-noselect file))) (goto-char pos)) 'help-echo (purecopy "mouse-2, RET: show corresponding NEWS announcement")) @@ -393,7 +404,8 @@ The format is (FUNCTION ARGS...).") ;;;###autoload (define-derived-mode help-mode special-mode "Help" "Major mode for viewing help text and navigating references in it. -Entry to this mode runs the normal hook `help-mode-hook'. +Also see the `help-enable-editing' variable. + Commands: \\{help-mode-map}" (setq-local revert-buffer-function @@ -818,7 +830,8 @@ The help buffers are divided into \"pages\" by the ^L character." (unless help-mode--current-data (error "No symbol to look up in the current buffer")) (info-lookup-symbol (plist-get help-mode--current-data :symbol) - 'emacs-lisp-mode)) + 'emacs-lisp-mode + help-window-keep-selected)) (defun help-goto-lispref-info () "View the Emacs Lisp manual *info* node of the current help item." diff --git a/lisp/help.el b/lisp/help.el index 780f5daac73..3c0370fee16 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -453,8 +453,8 @@ With argument, display info only for the selected version." ((< vn 18) "NEWS.1-17") (t (format "NEWS.%d" vn)))) res) - (view-file (expand-file-name file data-directory)) - (widen) + (find-file (expand-file-name file data-directory)) + (emacs-news-view-mode) (goto-char (point-min)) (when (stringp version) (when (re-search-forward @@ -867,7 +867,7 @@ with `mouse-movement' events." (memq 'down last-modifiers) ;; After a click, see if a double click is on the way. (and (memq 'click last-modifiers) - (not (sit-for (/ double-click-time 1000.0) t)))) + (not (sit-for (/ (mouse-double-click-time) 1000.0) t)))) (let* ((seq (read-key-sequence "\ Describe the following key, mouse click, or menu item: " nil nil 'can-return-switch-frame)) @@ -1273,7 +1273,8 @@ Otherwise, return a new string." (defvar help--keymaps-seen nil) (defun describe-map-tree (startmap &optional partial shadow prefix title - no-menu transl always-title mention-shadow) + no-menu transl always-title mention-shadow + buffer) "Insert a description of the key bindings in STARTMAP. This is followed by the key bindings of all maps reachable through STARTMAP. @@ -1299,7 +1300,10 @@ maps to look through. If MENTION-SHADOW is non-nil, then when something is shadowed by SHADOW, don't omit it; instead, mention it but say it is -shadowed." +shadowed. + +If BUFFER, lookup keys while in that buffer. This only affects +things like :filters for menu bindings." (let* ((amaps (accessible-keymaps startmap prefix)) (orig-maps (if no-menu (progn @@ -1340,7 +1344,8 @@ shadowed." (setq sub-shadows (cons (cdr (car tail)) sub-shadows))) (setq tail (cdr tail)))) (describe-map (cdr elt) elt-prefix transl partial - sub-shadows no-menu mention-shadow))) + sub-shadows no-menu mention-shadow + buffer))) (setq maps (cdr maps))) ;; Print title... (when (and print-title @@ -1418,13 +1423,13 @@ Return nil if the key sequence is too long." (t nil)))) (defun describe-map (map &optional prefix transl partial shadow - nomenu mention-shadow) + nomenu mention-shadow buffer) "Describe the contents of keymap MAP. Assume that this keymap itself is reached by the sequence of prefix keys PREFIX (a string or vector). -TRANSL, PARTIAL, SHADOW, NOMENU, MENTION-SHADOW are as in -`describe-map-tree'." +TRANSL, PARTIAL, SHADOW, NOMENU, MENTION-SHADOW and BUFFER are as +in `describe-map-tree'." ;; Converted from describe_map in keymap.c. (let* ((suppress (and partial 'suppress-keymap)) (map (keymap-canonicalize map)) @@ -1475,7 +1480,10 @@ TRANSL, PARTIAL, SHADOW, NOMENU, MENTION-SHADOW are as in ((and mention-shadow (not (eq tem definition))) (setq this-shadowed t)) (t nil)))) - (eq definition (lookup-key tail (vector event) t)) + (eq definition (if buffer + (with-current-buffer buffer + (lookup-key tail (vector event) t)) + (lookup-key tail (vector event) t))) (push (list event definition this-shadowed) vect)))) ((eq (car tail) 'keymap) ;; The same keymap might be in the structure twice, if @@ -1794,13 +1802,25 @@ the help window appears on another frame, it may get selected and its frame get input focus even if this option is nil. This option has effect if and only if the help window was created -by `with-help-window'." +by `with-help-window'. + +Also see `help-window-keep-selected'." :type '(choice (const :tag "never (nil)" nil) (const :tag "other" other) (const :tag "always (t)" t)) :group 'help :version "23.1") +(defcustom help-window-keep-selected nil + "If non-nil, navigation commands in the *Help* buffer will reuse the window. +If nil, many commands in the *Help* buffer, like \\<help-mode-map>\\[help-view-source] and \\[help-goto-info], will +pop to a different window to display the results. + +Also see `help-window-select'." + :type 'boolean + :group 'help + :version "29.1") + (define-obsolete-variable-alias 'help-enable-auto-load 'help-enable-autoload "27.1") @@ -2031,7 +2051,7 @@ the same names as used in the original source code, when possible." (if (and (symbolp def) (fboundp def)) (setq def (indirect-function def))) ;; Advice wrappers have "catch all" args, so fetch the actual underlying ;; function to find the real arguments. - (while (advice--p def) (setq def (advice--cdr def))) + (setq def (advice--cd*r def)) ;; If definition is a macro, find the function inside it. (if (eq (car-safe def) 'macro) (setq def (cdr def))) (cond diff --git a/lisp/image/exif.el b/lisp/image/exif.el index 35666b954ca..fd4673dc1b6 100644 --- a/lisp/image/exif.el +++ b/lisp/image/exif.el @@ -100,7 +100,10 @@ mirrored or not.") "Parse FILE (a JPEG file) and return the Exif data, if any. The return value is a list of Exif items. -If the data is invalid, an `exif-error' is signaled." +If the data is invalid, an `exif-error' is signaled. + +Also see the `exif-field' convenience function to extract data +from the return value of this function." (with-temp-buffer (set-buffer-multibyte nil) (insert-file-contents-literally file) @@ -110,7 +113,10 @@ If the data is invalid, an `exif-error' is signaled." "Parse BUFFER (which should be a JPEG file) and return the Exif data, if any. The return value is a list of Exif items. -If the data is invalid, an `exif-error' is signaled." +If the data is invalid, an `exif-error' is signaled. + +Also see the `exif-field' convenience function to extract data +from the return value of this function." (setq buffer (or buffer (current-buffer))) (with-current-buffer buffer (if enable-multibyte-characters diff --git a/lisp/image/image-converter.el b/lisp/image/image-converter.el index a339e95ab4a..7914d28c293 100644 --- a/lisp/image/image-converter.el +++ b/lisp/image/image-converter.el @@ -109,7 +109,7 @@ To pass in image data, IMAGE should a string containing the image data, and IMAGE-FORMAT should be a symbol with a MIME format name like \"image/webp\". For instance: - (image-convert data-string 'image/bmp) + (image-convert data-string \\='image/bmp) IMAGE can also be an image object as returned by `create-image'. diff --git a/lisp/info-look.el b/lisp/info-look.el index aa07c3f5e70..6c8ef091a08 100644 --- a/lisp/info-look.el +++ b/lisp/info-look.el @@ -280,7 +280,7 @@ system." ;;;###autoload (put 'info-lookup-symbol 'info-file "emacs") ;;;###autoload -(defun info-lookup-symbol (symbol &optional mode) +(defun info-lookup-symbol (symbol &optional mode same-window) "Look up and display documentation of SYMBOL in the relevant Info manual. SYMBOL should be an identifier: a function or method, a macro, a variable, a data type, a class, etc. @@ -293,10 +293,13 @@ MODE is the major mode whose Info manuals to search for the documentation of SYMBOL. It defaults to the current buffer's `major-mode'; if that mode doesn't have any Info manuals known to Emacs, the command will prompt for MODE to use, with completion. With prefix arg, the command -always prompts for MODE." +always prompts for MODE. + +Is SAME-WINDOW, try to reuse the current window instead of +popping up a new one." (interactive (info-lookup-interactive-arguments 'symbol current-prefix-arg)) - (info-lookup 'symbol symbol mode)) + (info-lookup 'symbol symbol mode same-window)) ;;;###autoload (put 'info-lookup-file 'info-file "emacs") ;;;###autoload @@ -388,7 +391,7 @@ If optional argument QUERY is non-nil, query for the help mode." spec mode))) -(defun info-lookup (topic item mode) +(defun info-lookup (topic item mode &optional same-window) "Display the documentation of TOPIC whose name is ITEM, using MODE's manuals. TOPIC should be any known symbol of a help topic type, such as `file' or `symbol'. See the documentation of HELP-TOPIC in the doc @@ -397,7 +400,10 @@ ITEM is the item whose documentation to search: file name if TOPIC is `file', a symbol if TOPIC is `symbol', etc. MODE is the `major-mode' whose Info manuals to search for documentation of ITEM; if it's nil, the function uses `info-lookup-file-name-alist' -and the current buffer's file name to guess the mode.." +and the current buffer's file name to guess the mode. + +If SAME-WINDOW, reuse the current window. If nil, pop to a +different window." (or mode (setq mode (info-lookup-select-mode))) (setq mode (info-lookup--item-to-mode item mode)) (if-let ((info (info-lookup->mode-value topic mode))) @@ -423,19 +429,21 @@ and the current buffer's file name to guess the mode.." (if (not info-lookup-other-window-flag) (info) (save-window-excursion (info)) - (let* ((info-window (get-buffer-window "*info*" t)) - (info-frame (and info-window (window-frame info-window)))) - (if (and info-frame - (not (eq info-frame (selected-frame))) - (display-multi-frame-p) - (memq info-frame (frames-on-display-list))) - ;; *info* is visible in another frame on same display. - ;; Raise that frame and select the window. - (progn - (select-window info-window) - (raise-frame info-frame)) - ;; In any other case, switch to *info* in another window. - (switch-to-buffer-other-window "*info*"))))) + (if same-window + (pop-to-buffer-same-window "*info*") + (let* ((info-window (get-buffer-window "*info*" t)) + (info-frame (and info-window (window-frame info-window)))) + (if (and info-frame + (not (eq info-frame (selected-frame))) + (display-multi-frame-p) + (memq info-frame (frames-on-display-list))) + ;; *info* is visible in another frame on same display. + ;; Raise that frame and select the window. + (progn + (select-window info-window) + (raise-frame info-frame)) + ;; In any other case, switch to *info* another window. + (switch-to-buffer-other-window "*info*")))))) (while (and (not found) modes) (setq doc-spec (info-lookup->doc-spec topic (car modes))) (while (and (not found) doc-spec) diff --git a/lisp/info.el b/lisp/info.el index db95574bf72..abfb77b0552 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -907,17 +907,20 @@ find a node." filename))) filename)))) -(defun Info-find-node (filename nodename &optional no-going-back strict-case) +(defun Info-find-node (filename nodename &optional no-going-back strict-case + noerror) "Go to an Info node specified as separate FILENAME and NODENAME. NO-GOING-BACK is non-nil if recovering from an error in this function; it says do not attempt further (recursive) error recovery. This function first looks for a case-sensitive match for NODENAME; if none is found it then tries a case-insensitive match (unless -STRICT-CASE is non-nil)." +STRICT-CASE is non-nil). + +If NOERROR, inhibit error messages when we can't find the node." (info-initialize) (setq nodename (info--node-canonicalize-whitespace nodename)) - (setq filename (Info-find-file filename)) + (setq filename (Info-find-file filename noerror)) ;; Go into Info buffer. (or (derived-mode-p 'Info-mode) (switch-to-buffer "*info*")) ;; Record the node we are leaving, if we were in one. @@ -1822,41 +1825,22 @@ directories to search if FILENAME is not absolute; SUFFIXES is a list of valid filename suffixes for Info files. See `try-completion' for a description of the remaining arguments." (setq suffixes (remove "" suffixes)) - (when (file-name-absolute-p string) - (setq dirs (list (file-name-directory string)))) (let ((names nil) - (names-sans-suffix nil) - (suffix (concat (regexp-opt suffixes t) "\\'")) - (string-dir (file-name-directory string))) + (suffix (concat (regexp-opt suffixes t) "\\'"))) (dolist (dir dirs) - (unless dir - (setq dir default-directory)) - (if string-dir (setq dir (expand-file-name string-dir dir))) (when (file-directory-p dir) - (dolist (file (file-name-all-completions - (file-name-nondirectory string) dir)) - ;; If the file name has no suffix or a standard suffix, - ;; include it. - (and (or (null (file-name-extension file)) - (string-match suffix file)) - ;; But exclude subfiles of split Info files. - (not (string-match "-[0-9]+\\'" file)) - ;; And exclude backup files. - (not (string-match "~\\'" file)) - (push (if string-dir (concat string-dir file) file) names)) - ;; If the file name ends in a standard suffix, - ;; add the unsuffixed name as a completion option. - (when (string-match suffix file) - (setq file (substring file 0 (match-beginning 0))) - (push (if string-dir (concat string-dir file) file) - names-sans-suffix))))) - ;; If there is just one file, don't duplicate it with suffixes, - ;; so `Info-read-node-name-1' will be able to complete a single - ;; candidate and to add the terminating ")". - (if (and (= (length names) 1) (= (length names-sans-suffix) 1)) - (setq names names-sans-suffix) - (setq names (append names-sans-suffix names))) - (complete-with-action action names string pred))) + (dolist (file (directory-files dir)) + ;; If the file name has a standard suffix, + ;; include it (without the suffix). + (when (and (string-match suffix file) + ;; But exclude subfiles of split Info files. + (not (string-match "\.info-[0-9]+" file)) + ;; And exclude backup files. + (not (string-match "~\\'" file))) + (push (substring file 0 (match-beginning 0)) + names))))) + (complete-with-action action (delete-dups (nreverse names)) + string pred))) (defun Info-read-node-name-1 (string predicate code) "Internal function used by `Info-read-node-name'. @@ -2615,7 +2599,8 @@ new buffer." (if (eq alt-default t) (setq alt-default str)) ;; Don't add this string if it's a duplicate. (or (assoc-string str completions t) - (push str completions)))) + (push str completions))) + (setq completions (nreverse completions))) ;; If no good default was found, try an alternate. (or default (setq default alt-default)) @@ -3632,13 +3617,16 @@ MATCHES is a list of index matches found by `Info-apropos-matches'.") (format " (line %s)" (nth 3 entry)) ""))))))))) -(defun Info-apropos-matches (string) +(defun Info-apropos-matches (string &optional regexp) "Collect STRING matches from all known Info files on your system. +If REGEXP, use regexp matching instead of literal matching. Return a list of matches where each element is in the format \((FILENAME INDEXTEXT NODENAME LINENUMBER))." (unless (string= string "") (let ((pattern (format "\n\\* +\\([^\n]*\\(%s\\)[^\n]*\\):[ \t]+\\([^\n]+\\)\\.\\(?:[ \t\n]*(line +\\([0-9]+\\))\\)?" - (regexp-quote string))) + (if regexp + string + (regexp-quote string)))) (ohist Info-history) (ohist-list Info-history-list) (current-node Info-current-node) @@ -3663,9 +3651,9 @@ Return a list of matches where each element is in the format (dolist (manual (nreverse manuals)) (message "Searching %s" manual) (condition-case err - (if (setq nodes (Info-index-nodes (Info-find-file manual))) + (if (setq nodes (Info-index-nodes (Info-find-file manual t))) (save-excursion - (Info-find-node manual (car nodes)) + (Info-find-node manual (car nodes) nil nil t) (while (progn (goto-char (point-min)) @@ -3692,19 +3680,22 @@ Return a list of matches where each element is in the format (or (nreverse matches) t)))) ;;;###autoload -(defun info-apropos (string) - "Grovel indices of all known Info files on your system for STRING. -Build a menu of the possible matches." - (interactive "sIndex apropos: ") +(defun info-apropos (string &optional regexp) + "Search indices of all known Info files on your system for STRING. +If REGEXP (interactively, the prefix), use a regexp match. + +Display a menu of the possible matches." + (interactive "sIndex apropos: \nP") (if (equal string "") (Info-find-node Info-apropos-file "Top") - (let* ((nodes Info-apropos-nodes) nodename) + (let ((nodes Info-apropos-nodes) + nodename) (while (and nodes (not (equal string (nth 1 (car nodes))))) (setq nodes (cdr nodes))) (if nodes - (Info-find-node Info-apropos-file (car (car nodes))) + (Info-find-node Info-apropos-file (car (car nodes)) nil nil t) (setq nodename (format "Index for ‘%s’" string)) - (push (list nodename string (Info-apropos-matches string)) + (push (list nodename string (Info-apropos-matches string regexp)) Info-apropos-nodes) (Info-find-node Info-apropos-file nodename))))) @@ -4295,7 +4286,8 @@ If FORK is non-nil, it is passed to `Info-goto-node'." (substring str (match-end 0)))) (setq i (1+ i))) (setq items - (cons str items)))) + (cons str items))) + (setq items (nreverse items))) (while (and items (< number 9)) (setq current (car items) items (cdr items) @@ -5440,7 +5432,8 @@ completion alternatives to currently visited manuals." (progn (info-initialize) (completing-read "Manual name: " - (info--manual-names current-prefix-arg) + (info--filter-manual-names + (info--manual-names current-prefix-arg)) nil t)))) (let ((blist (buffer-list)) (manual-re (concat "\\(/\\|\\`\\)" manual "\\(\\.\\|\\'\\)")) @@ -5468,6 +5461,22 @@ completion alternatives to currently visited manuals." (info (Info-find-file manual) (generate-new-buffer-name "*info*"))))) +(defun info--filter-manual-names (names) + (cl-flet ((strip (name) + (replace-regexp-in-string "\\([-.]info\\)?\\(\\.gz\\)?\\'" + "" name))) + (seq-uniq (sort (seq-filter + (lambda (name) + (and (not (string-match-p "info-[0-9]" name)) + (not (member name '("./" "../" "ChangeLog" + "NEWS" "README"))))) + names) + ;; We prefer the shorter names ("foo" over "foo.gz"). + (lambda (s1 s2) + (< (length s1) (length s2)))) + (lambda (s1 s2) + (equal (strip s1) (strip s2)))))) + (defun info--manual-names (visited-only) (let (names) (dolist (buffer (buffer-list)) diff --git a/lisp/international/ccl.el b/lisp/international/ccl.el index 9188e3d6ae4..c7d883276db 100644 --- a/lisp/international/ccl.el +++ b/lisp/international/ccl.el @@ -577,7 +577,7 @@ Return register which holds a value of the expression." (ccl-check-register expr cmd))) (defun ccl-compile-branch-blocks (code rrr blocks) - "Compile BLOCKs of BRANCH statement. CODE is 'branch or 'read-branch. + "Compile BLOCKs of BRANCH statement. CODE is `branch' or `read-branch'. REG is a register which holds a value of EXPRESSION part. BLOCKs is a list of CCL-BLOCKs." (let ((branches (length blocks)) diff --git a/lisp/international/characters.el b/lisp/international/characters.el index 63ac455ea6a..ca28222c815 100644 --- a/lisp/international/characters.el +++ b/lisp/international/characters.el @@ -303,7 +303,8 @@ with L, LRE, or LRO Unicode bidi character type.") (setq charsets (cdr charsets)))) (modify-category-entry '(#x600 . #x6ff) ?b) (modify-category-entry '(#x870 . #x8ff) ?b) -(modify-category-entry '(#xfb50 . #xfdff) ?b) +(modify-category-entry '(#xfb50 . #xfdcf) ?b) +(modify-category-entry '(#xfdf0 . #xfdff) ?b) (modify-category-entry '(#xfe70 . #xfefe) ?b) ;; Cyrillic character set (ISO-8859-5) diff --git a/lisp/international/fontset.el b/lisp/international/fontset.el index 1950a409354..883f08905e9 100644 --- a/lisp/international/fontset.el +++ b/lisp/international/fontset.el @@ -231,6 +231,7 @@ (chorasmian #x10FB0) (elymaic #x10FE0) (old-uyghur #x10F70) + (brahmi #x11013 #x11045 #x11052 #x11065) (mahajani #x11150) (khojki #x11200) (khudawadi #x112B0) @@ -770,6 +771,7 @@ chorasmian elymaic old-uyghur + brahmi makasar dives-akuru cuneiform diff --git a/lisp/isearch.el b/lisp/isearch.el index 168d71ada3a..8397bb95c6b 100644 --- a/lisp/isearch.el +++ b/lisp/isearch.el @@ -868,14 +868,16 @@ This variable is set and changed during isearch. To change the default behavior used for searches, see `search-default-mode' instead.") -(defvar isearch-lax-whitespace t +(defcustom isearch-lax-whitespace t "If non-nil, a space will match a sequence of whitespace chars. When you enter a space or spaces in ordinary incremental search, it will match any sequence matched by the regexp defined by the variable `search-whitespace-regexp'. If the value is nil, each space you type matches literally, against one space. You can toggle the value of this variable by the command `isearch-toggle-lax-whitespace', usually bound to -`M-s SPC' during isearch.") +`M-s SPC' during isearch." + :type 'boolean + :version "25.1") (defvar isearch-regexp-lax-whitespace nil "If non-nil, a space will match a sequence of whitespace chars. @@ -2329,7 +2331,12 @@ arg means replace backward. Note that using the prefix arg is possible only when `isearch-allow-scroll' is non-nil or `isearch-allow-prefix' is non-nil, and it doesn't always provide the correct matches for `query-replace', so the preferred way to run word -replacements from Isearch is `M-s w ... M-%'." +replacements from Isearch is `M-s w ... M-%'. + +As each match is found, the user must type a character saying +what to do with it. Type SPC or `y' to replace the match, +DEL or `n' to skip and go to the next match. For more directions, +type \\[help-command] at that time." (interactive (list current-prefix-arg)) (barf-if-buffer-read-only) @@ -2383,7 +2390,12 @@ replacements from Isearch is `M-s w ... M-%'." (defun isearch-query-replace-regexp (&optional arg) "Start `query-replace-regexp' with string to replace from last search string. -See `isearch-query-replace' for more information." +See `isearch-query-replace' for more information. + +As each match is found, the user must type a character saying +what to do with it. Type SPC or `y' to replace the match, +DEL or `n' to skip and go to the next match. For more directions, +type \\[help-command] at that time." (interactive (list current-prefix-arg)) (isearch-query-replace arg t)) @@ -2629,9 +2641,10 @@ is bound to outside of Isearch." ;; Key search depends on mode (bug#47755) (isearch-mode nil)) (key-binding (this-command-keys-vector) t)))) - (if (and (window-minibuffer-p w) - (not (minibuffer-window-active-p w))) ; in echo area - (isearch-yank-x-selection) + (if (or mouse-yank-at-point + (and (window-minibuffer-p w) + (not (minibuffer-window-active-p w)))) ; in echo area + (isearch-yank-x-selection) (when (functionp binding) (call-interactively binding))))) diff --git a/lisp/keymap.el b/lisp/keymap.el index c0fdf8721b2..71454eba5e5 100644 --- a/lisp/keymap.el +++ b/lisp/keymap.el @@ -281,18 +281,7 @@ See `kbd' for a descripion of KEYS." (when key (dolist (_ (number-sequence 1 times)) (setq res (vconcat res key)))))) - (if (and (>= (length res) 4) - (eq (aref res 0) ?\C-x) - (eq (aref res 1) ?\() - (eq (aref res (- (length res) 2)) ?\C-x) - (eq (aref res (- (length res) 1)) ?\))) - (apply #'vector (let ((lres (append res nil))) - ;; Remove the first and last two elements. - (setq lres (cdr (cdr lres))) - (nreverse lres) - (setq lres (cdr (cdr lres))) - (nreverse lres))) - res)))) + res))) (defun key-valid-p (keys) "Say whether KEYS is a valid key. @@ -306,10 +295,10 @@ number of characters have a special shorthand syntax. Here's some example key sequences. - \"f\" (the key 'f') - \"S o m\" (a three key sequence of the keys 'S', 'o' and 'm') - \"C-c o\" (a two key sequence of the keys 'c' with the control modifier - and then the key 'o') + \"f\" (the key `f') + \"S o m\" (a three key sequence of the keys `S', `o' and `m') + \"C-c o\" (a two key sequence of the keys `c' with the control modifier + and then the key `o') \"H-<left>\" (the key named \"left\" with the hyper modifier) \"M-RET\" (the \"return\" key with a meta modifier) \"C-M-<space>\" (the \"space\" key with both the control and meta modifiers) diff --git a/lisp/kmacro.el b/lisp/kmacro.el index 8a9d89929eb..3f1f12fad6f 100644 --- a/lisp/kmacro.el +++ b/lisp/kmacro.el @@ -820,13 +820,14 @@ KEYS should be a vector or a string that obeys `key-valid-p'." (counter (or counter 0)) (format (or format "%d"))) (&optional arg) - (interactive "p") ;; Use counter and format specific to the macro on the ring! (let ((kmacro-counter counter) (kmacro-counter-format-start format)) (execute-kbd-macro keys arg #'kmacro-loop-setup-function) (setq counter kmacro-counter)))) +(cl-defmethod oclosure-interactive-form ((_ kmacro)) '(interactive "p")) + ;;;###autoload (defun kmacro-lambda-form (mac &optional counter format) ;; Apparently, there are two different ways this is called: @@ -953,7 +954,7 @@ Such a \"function\" cannot be called from Lisp, but it is a valid editor command (cl-defmethod register-val-describe ((data kmacro-register) _verbose) (princ (format "a keyboard macro:\n %s" - (format-kbd-macro (kmacro-register-macro data))))) + (key-description (kmacro-register-macro data))))) (cl-defmethod register-val-insert ((data kmacro-register)) (insert (format-kbd-macro (kmacro-register-macro data)))) diff --git a/lisp/language/indian.el b/lisp/language/indian.el index e0adb0de6c3..c3d59b6f770 100644 --- a/lisp/language/indian.el +++ b/lisp/language/indian.el @@ -126,6 +126,17 @@ environment.")) South Indian language Malayalam is supported in this language environment.")) '("Indian")) +(set-language-info-alist + "Brahmi" '((charset unicode) + (coding-system utf-8) + (coding-priority utf-8) + (input-method . "brahmi") + (sample-text . "Brahmi (𑀩ð‘†ð‘€ð‘€¸ð‘€³ð‘†ð‘€«ð‘€») 𑀦𑀫𑀲ð‘†ð‘€¢ð‘‚") + (documentation . "\ +The ancient Brahmi script is supported in this language environment.")) + '("Indian")) ; Should we have an "Old" category? + + ;; Replace mnemonic characters in REGEXP according to TABLE. TABLE is ;; an alist of (MNEMONIC-STRING . REPLACEMENT-STRING). @@ -384,6 +395,32 @@ South Indian language Malayalam is supported in this language environment.")) (list (vector (cdr slot) 0 #'font-shape-gstring)))))) char-script-table)) +;; Brahmi composition rules +(let ((consonant "[\U00011013-\U00011034]") + (non-consonant "[^\U00011013-\U00011034\U00011046\U0001107F]") + (vowel "[\U00011038-\U00011045]") + (numeral "[\U00011052-\U00011065]") + (multiplier "[\U00011064\U00011065]") + (virama "\U00011046") + (number-joiner "\U0001107F")) + (set-char-table-range composition-function-table + '(#x11046 . #x11046) + (list (vector + ;; Consonant conjuncts + (concat consonant "\\(?:" virama consonant "\\)+" + vowel "?") + 1 'font-shape-gstring) + (vector + ;; Vowelless consonants + (concat consonant virama non-consonant) + 1 'font-shape-gstring))) + (set-char-table-range composition-function-table + '(#x1107F . #x1107F) + (list (vector + ;; Additive-multiplicative numerals + (concat multiplier number-joiner numeral) + 1 'font-shape-gstring)))) + (provide 'indian) ;;; indian.el ends here diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index 5dd4291461c..a049f65e4d0 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -527,20 +527,6 @@ Return t if `allout-mode' is active in current buffer." nil t) (autoload 'allout-mode "allout" "\ Toggle Allout outline mode. -This is a minor mode. If called interactively, toggle the `Allout -mode' mode. If the prefix argument is positive, enable the mode, and -if it is zero or negative, disable the mode. - -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. - -To check whether the minor mode is enabled in the current buffer, -evaluate `allout-mode'. - -The mode's hook is called both when the mode is enabled and when it is -disabled. - \\<allout-mode-map-value> Allout outline mode is a minor mode that provides extensive outline oriented formatting and manipulation. It enables @@ -801,6 +787,20 @@ CONCEALED: CLOSED: A TOPIC whose immediate OFFSPRING and body-text is CONCEALED. OPEN: A TOPIC that is not CLOSED, though its OFFSPRING or BODY may be. +This is a minor mode. If called interactively, toggle the +`Allout mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. + +To check whether the minor mode is enabled in the current buffer, +evaluate `allout-mode'. + +The mode's hook is called both when the mode is enabled and when +it is disabled. + \(fn &optional ARG)" t nil) (defalias 'outlinify-sticky #'outlineify-sticky) @@ -851,20 +851,6 @@ See `allout-widgets-mode' for allout widgets mode features.") (autoload 'allout-widgets-mode "allout-widgets" "\ Toggle Allout Widgets mode. -This is a minor mode. If called interactively, toggle the -`Allout-Widgets mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. - -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. - -To check whether the minor mode is enabled in the current buffer, -evaluate `allout-widgets-mode'. - -The mode's hook is called both when the mode is enabled and when it is -disabled. - Allout Widgets mode is an extension of Allout mode that provides graphical decoration of outline structure. It is meant to operate along with `allout-mode', via `allout-mode-hook'. @@ -883,6 +869,20 @@ The bullet-icon and guide line graphics provide keybindings and mouse bindings for easy outline navigation and exposure control, extending outline hot-spot navigation (see `allout-mode'). +This is a minor mode. If called interactively, toggle the +`Allout-Widgets mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. + +To check whether the minor mode is enabled in the current buffer, +evaluate `allout-widgets-mode'. + +The mode's hook is called both when the mode is enabled and when +it is disabled. + \(fn &optional ARG)" t nil) (register-definition-prefixes "allout-widgets" '("allout-")) @@ -1286,20 +1286,6 @@ Entering array mode calls the function `array-mode-hook'. (autoload 'artist-mode "artist" "\ Toggle Artist mode. -This is a minor mode. If called interactively, toggle the `Artist -mode' mode. If the prefix argument is positive, enable the mode, and -if it is zero or negative, disable the mode. - -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. - -To check whether the minor mode is enabled in the current buffer, -evaluate `artist-mode'. - -The mode's hook is called both when the mode is enabled and when it is -disabled. - Artist lets you draw lines, squares, rectangles and poly-lines, ellipses and circles with your mouse and/or keyboard. @@ -1495,6 +1481,20 @@ Keymap summary \\{artist-mode-map} +This is a minor mode. If called interactively, toggle the +`Artist mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. + +To check whether the minor mode is enabled in the current buffer, +evaluate `artist-mode'. + +The mode's hook is called both when the mode is enabled and when +it is disabled. + \(fn &optional ARG)" t nil) (register-definition-prefixes "artist" '("artist-")) @@ -1622,22 +1622,22 @@ or call the function `auto-insert-mode'.") (autoload 'auto-insert-mode "autoinsert" "\ Toggle Auto-insert mode, a global minor mode. -This is a minor mode. If called interactively, toggle the -`Auto-Insert mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. +When Auto-insert mode is enabled, when new files are created you can +insert a template for the file depending on the mode of the buffer. + +This is a global minor mode. If called interactively, toggle the +`Auto-Insert mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='auto-insert-mode)'. -The mode's hook is called both when the mode is enabled and when it is -disabled. - -When Auto-insert mode is enabled, when new files are created you can -insert a template for the file depending on the mode of the buffer. +The mode's hook is called both when the mode is enabled and when +it is disabled. \(fn &optional ARG)" t nil) @@ -1718,20 +1718,6 @@ should be non-nil)." nil nil) (autoload 'auto-revert-mode "autorevert" "\ Toggle reverting buffer when the file changes (Auto-Revert Mode). -This is a minor mode. If called interactively, toggle the -`Auto-Revert mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. - -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. - -To check whether the minor mode is enabled in the current buffer, -evaluate `auto-revert-mode'. - -The mode's hook is called both when the mode is enabled and when it is -disabled. - Auto-Revert Mode is a minor mode that affects only the current buffer. When enabled, it reverts the buffer when the file on disk changes. @@ -1747,6 +1733,20 @@ Use `global-auto-revert-mode' to automatically revert all buffers. Use `auto-revert-tail-mode' if you know that the file will only grow without being changed in the part that is already in the buffer. +This is a minor mode. If called interactively, toggle the +`Auto-Revert mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. + +To check whether the minor mode is enabled in the current buffer, +evaluate `auto-revert-mode'. + +The mode's hook is called both when the mode is enabled and when +it is disabled. + \(fn &optional ARG)" t nil) (autoload 'turn-on-auto-revert-mode "autorevert" "\ @@ -1758,20 +1758,6 @@ This function is designed to be added to hooks, for example: (autoload 'auto-revert-tail-mode "autorevert" "\ Toggle reverting tail of buffer when the file grows. -This is a minor mode. If called interactively, toggle the -`Auto-Revert-Tail mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. - -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. - -To check whether the minor mode is enabled in the current buffer, -evaluate `auto-revert-tail-mode'. - -The mode's hook is called both when the mode is enabled and when it is -disabled. - When Auto-Revert Tail Mode is enabled, the tail of the file is constantly followed, as with the shell command `tail -f'. This means that whenever the file grows on disk (presumably because @@ -1787,6 +1773,21 @@ suppressed by setting `auto-revert-verbose' to nil. Use `auto-revert-mode' for changes other than appends! +This is a minor mode. If called interactively, toggle the +`Auto-Revert-Tail mode' mode. If the prefix argument is +positive, enable the mode, and if it is zero or negative, disable +the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. + +To check whether the minor mode is enabled in the current buffer, +evaluate `auto-revert-tail-mode'. + +The mode's hook is called both when the mode is enabled and when +it is disabled. + \(fn &optional ARG)" t nil) (autoload 'turn-on-auto-revert-tail-mode "autorevert" "\ @@ -1808,20 +1809,6 @@ or call the function `global-auto-revert-mode'.") (autoload 'global-auto-revert-mode "autorevert" "\ Toggle Global Auto-Revert Mode. -This is a minor mode. If called interactively, toggle the `Global -Auto-Revert mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. - -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. - -To check whether the minor mode is enabled in the current buffer, -evaluate `(default-value \\='global-auto-revert-mode)'. - -The mode's hook is called both when the mode is enabled and when it is -disabled. - Global Auto-Revert Mode is a global minor mode that reverts any buffer associated with a file when the file changes on disk. Use `auto-revert-mode' to revert a particular buffer. @@ -1839,6 +1826,21 @@ This function calls the hook `global-auto-revert-mode-hook'. It displays the text that `global-auto-revert-mode-text' specifies in the mode line. +This is a global minor mode. If called interactively, toggle the +`Global Auto-Revert mode' mode. If the prefix argument is +positive, enable the mode, and if it is zero or negative, disable +the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. + +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value \\='global-auto-revert-mode)'. + +The mode's hook is called both when the mode is enabled and when +it is disabled. + \(fn &optional ARG)" t nil) (register-definition-prefixes "autorevert" '("auto-revert-" "global-auto-revert-")) @@ -1947,24 +1949,24 @@ or call the function `display-battery-mode'.") (autoload 'display-battery-mode "battery" "\ Toggle battery status display in mode line (Display Battery mode). -This is a minor mode. If called interactively, toggle the +The text displayed in the mode line is controlled by +`battery-mode-line-format' and `battery-status-function'. +The mode line is be updated every `battery-update-interval' +seconds. + +This is a global minor mode. If called interactively, toggle the `Display-Battery mode' mode. If the prefix argument is positive, enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='display-battery-mode)'. -The mode's hook is called both when the mode is enabled and when it is -disabled. - -The text displayed in the mode line is controlled by -`battery-mode-line-format' and `battery-status-function'. -The mode line is be updated every `battery-update-interval' -seconds. +The mode's hook is called both when the mode is enabled and when +it is disabled. \(fn &optional ARG)" t nil) @@ -2930,18 +2932,18 @@ columns on its right towards the left. Toggle hyperlinking bug references in the buffer (Bug Reference mode). This is a minor mode. If called interactively, toggle the -`Bug-Reference mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. +`Bug-Reference mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `bug-reference-mode'. -The mode's hook is called both when the mode is enabled and when it is -disabled. +The mode's hook is called both when the mode is enabled and when +it is disabled. \(fn &optional ARG)" t nil) @@ -2949,18 +2951,19 @@ disabled. Like `bug-reference-mode', but only buttonize in comments and strings. This is a minor mode. If called interactively, toggle the -`Bug-Reference-Prog mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +`Bug-Reference-Prog mode' mode. If the prefix argument is +positive, enable the mode, and if it is zero or negative, disable +the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `bug-reference-prog-mode'. -The mode's hook is called both when the mode is enabled and when it is -disabled. +The mode's hook is called both when the mode is enabled and when +it is disabled. \(fn &optional ARG)" t nil) @@ -4722,26 +4725,26 @@ Prefix argument is the same as for `checkdoc-defun'." t nil) (autoload 'checkdoc-minor-mode "checkdoc" "\ Toggle automatic docstring checking (Checkdoc minor mode). -This is a minor mode. If called interactively, toggle the `Checkdoc -minor mode' mode. If the prefix argument is positive, enable the -mode, and if it is zero or negative, disable the mode. - -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. - -To check whether the minor mode is enabled in the current buffer, -evaluate `checkdoc-minor-mode'. - -The mode's hook is called both when the mode is enabled and when it is -disabled. - In Checkdoc minor mode, the usual bindings for `eval-defun' which is bound to \\<checkdoc-minor-mode-map>\\[checkdoc-eval-defun] and `checkdoc-eval-current-buffer' are overridden to include checking of documentation strings. \\{checkdoc-minor-mode-map} +This is a minor mode. If called interactively, toggle the +`Checkdoc minor mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. + +To check whether the minor mode is enabled in the current buffer, +evaluate `checkdoc-minor-mode'. + +The mode's hook is called both when the mode is enabled and when +it is disabled. + \(fn &optional ARG)" t nil) (autoload 'checkdoc-package-keywords "checkdoc" "\ @@ -4841,20 +4844,20 @@ or call the function `cl-font-lock-built-in-mode'.") (autoload 'cl-font-lock-built-in-mode "cl-font-lock" "\ Highlight built-in functions, variables, and types in `lisp-mode'. -This is a minor mode. If called interactively, toggle the +This is a global minor mode. If called interactively, toggle the `Cl-Font-Lock-Built-In mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable the -mode. +positive, enable the mode, and if it is zero or negative, disable +the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='cl-font-lock-built-in-mode)'. -The mode's hook is called both when the mode is enabled and when it is -disabled. +The mode's hook is called both when the mode is enabled and when +it is disabled. \(fn &optional ARG)" t nil) @@ -4941,7 +4944,7 @@ The set of acceptable TYPEs (also called \"specializers\") is defined (autoload 'cl-generic-define-method "cl-generic" "\ -\(fn NAME QUALIFIERS ARGS USES-CNM FUNCTION)" nil nil) +\(fn NAME QUALIFIERS ARGS CALL-CON FUNCTION)" nil nil) (autoload 'cl-find-method "cl-generic" "\ @@ -5059,6 +5062,9 @@ Increment PLACE by X (1 by default). PLACE may be a symbol, or any generalized variable allowed by `setf'. The return value is the incremented value of PLACE. +If X is specified, it should be an expression that should +evaluate to a number. + \(fn PLACE &optional X)" nil t) (defvar cl-old-struct-compat-mode nil "\ @@ -5073,23 +5079,25 @@ or call the function `cl-old-struct-compat-mode'.") (autoload 'cl-old-struct-compat-mode "cl-lib" "\ Enable backward compatibility with old-style structs. + This can be needed when using code byte-compiled using the old macro-expansion of `cl-defstruct' that used vectors objects instead of record objects. -This is a minor mode. If called interactively, toggle the -`Cl-Old-Struct-Compat mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +This is a global minor mode. If called interactively, toggle the +`Cl-Old-Struct-Compat mode' mode. If the prefix argument is +positive, enable the mode, and if it is zero or negative, disable +the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='cl-old-struct-compat-mode)'. -The mode's hook is called both when the mode is enabled and when it is -disabled. +The mode's hook is called both when the mode is enabled and when +it is disabled. \(fn &optional ARG)" t nil) @@ -5389,7 +5397,7 @@ Generate .elc files in addition to the .eln files. Force the produced .eln to be outputted in the eln system directory (the last entry in `native-comp-eln-load-path') unless `native-compile-target-directory' is non-nil. If the environment -variable 'NATIVE_DISABLED' is set, only byte compile." nil nil) +variable \"NATIVE_DISABLED\" is set, only byte compile." nil nil) (autoload 'native-compile-async "comp" "\ Compile FILES asynchronously. @@ -5617,48 +5625,49 @@ Runs `compilation-mode-hook' with `run-mode-hooks' (which see). (autoload 'compilation-shell-minor-mode "compile" "\ Toggle Compilation Shell minor mode. +When Compilation Shell minor mode is enabled, all the +error-parsing commands of the Compilation major mode are +available but bound to keys that don't collide with Shell mode. +See `compilation-mode'. + This is a minor mode. If called interactively, toggle the `Compilation-Shell minor mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable the -mode. +positive, enable the mode, and if it is zero or negative, disable +the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `compilation-shell-minor-mode'. -The mode's hook is called both when the mode is enabled and when it is -disabled. - -When Compilation Shell minor mode is enabled, all the -error-parsing commands of the Compilation major mode are -available but bound to keys that don't collide with Shell mode. -See `compilation-mode'. +The mode's hook is called both when the mode is enabled and when +it is disabled. \(fn &optional ARG)" t nil) (autoload 'compilation-minor-mode "compile" "\ Toggle Compilation minor mode. +When Compilation minor mode is enabled, all the error-parsing +commands of Compilation major mode are available. See +`compilation-mode'. + This is a minor mode. If called interactively, toggle the -`Compilation minor mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +`Compilation minor mode' mode. If the prefix argument is +positive, enable the mode, and if it is zero or negative, disable +the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `compilation-minor-mode'. -The mode's hook is called both when the mode is enabled and when it is -disabled. - -When Compilation minor mode is enabled, all the error-parsing -commands of Compilation major mode are available. See -`compilation-mode'. +The mode's hook is called both when the mode is enabled and when +it is disabled. \(fn &optional ARG)" t nil) @@ -5688,19 +5697,20 @@ or call the function `dynamic-completion-mode'.") (autoload 'dynamic-completion-mode "completion" "\ Toggle dynamic word-completion on or off. -This is a minor mode. If called interactively, toggle the -`Dynamic-Completion mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +This is a global minor mode. If called interactively, toggle the +`Dynamic-Completion mode' mode. If the prefix argument is +positive, enable the mode, and if it is zero or negative, disable +the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='dynamic-completion-mode)'. -The mode's hook is called both when the mode is enabled and when it is -disabled. +The mode's hook is called both when the mode is enabled and when +it is disabled. \(fn &optional ARG)" t nil) @@ -6257,20 +6267,6 @@ or call the function `cua-mode'.") (autoload 'cua-mode "cua-base" "\ Toggle Common User Access style editing (CUA mode). -This is a minor mode. If called interactively, toggle the `Cua mode' -mode. If the prefix argument is positive, enable the mode, and if it -is zero or negative, disable the mode. - -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. - -To check whether the minor mode is enabled in the current buffer, -evaluate `(default-value \\='cua-mode)'. - -The mode's hook is called both when the mode is enabled and when it is -disabled. - CUA mode is a global minor mode. When enabled, typed text replaces the active selection, and you can use C-z, C-x, C-c, and C-v to undo, cut, copy, and paste in addition to the normal Emacs @@ -6289,6 +6285,20 @@ You can customize `cua-enable-cua-keys' to completely disable the CUA bindings, or `cua-prefix-override-inhibit-delay' to change the prefix fallback behavior. +This is a global minor mode. If called interactively, toggle the +`Cua mode' mode. If the prefix argument is positive, enable the +mode, and if it is zero or negative, disable the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. + +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value \\='cua-mode)'. + +The mode's hook is called both when the mode is enabled and when +it is disabled. + \(fn &optional ARG)" t nil) (autoload 'cua-selection-mode "cua-base" "\ @@ -6312,21 +6322,23 @@ Enable CUA selection mode without the C-z/C-x/C-c/C-v bindings. (autoload 'cua-rectangle-mark-mode "cua-rect" "\ Toggle the region as rectangular. + Activates the region if needed. Only lasts until the region is deactivated. This is a minor mode. If called interactively, toggle the -`Cua-Rectangle-Mark mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +`Cua-Rectangle-Mark mode' mode. If the prefix argument is +positive, enable the mode, and if it is zero or negative, disable +the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `cua-rectangle-mark-mode'. -The mode's hook is called both when the mode is enabled and when it is -disabled. +The mode's hook is called both when the mode is enabled and when +it is disabled. \(fn &optional ARG)" t nil) @@ -6347,23 +6359,25 @@ By convention, this is a list of symbols where each symbol stands for the Keep cursor outside of any `cursor-intangible' text property. This is a minor mode. If called interactively, toggle the -`Cursor-Intangible mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +`Cursor-Intangible mode' mode. If the prefix argument is +positive, enable the mode, and if it is zero or negative, disable +the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `cursor-intangible-mode'. -The mode's hook is called both when the mode is enabled and when it is -disabled. +The mode's hook is called both when the mode is enabled and when +it is disabled. \(fn &optional ARG)" t nil) (autoload 'cursor-sensor-mode "cursor-sensor" "\ Handle the `cursor-sensor-functions' text property. + This property should hold a list of functions which react to the motion of the cursor. They're called with three arguments (WINDOW OLDPOS DIR) where WINDOW is the affected window, OLDPOS is the last known position of @@ -6371,18 +6385,18 @@ the cursor and DIR can be `entered' or `left' depending on whether the cursor is entering the area covered by the text-property property or leaving it. This is a minor mode. If called interactively, toggle the -`Cursor-Sensor mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. +`Cursor-Sensor mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `cursor-sensor-mode'. -The mode's hook is called both when the mode is enabled and when it is -disabled. +The mode's hook is called both when the mode is enabled and when +it is disabled. \(fn &optional ARG)" t nil) @@ -6772,25 +6786,25 @@ Mode used for cvs status output. (autoload 'cwarn-mode "cwarn" "\ Minor mode that highlights suspicious C and C++ constructions. +Suspicious constructs are highlighted using `font-lock-warning-face'. + +Note, in addition to enabling this minor mode, the major mode must +be included in the variable `cwarn-configuration'. By default C and +C++ modes are included. + This is a minor mode. If called interactively, toggle the `Cwarn -mode' mode. If the prefix argument is positive, enable the mode, and -if it is zero or negative, disable the mode. +mode' mode. If the prefix argument is positive, enable the mode, +and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `cwarn-mode'. -The mode's hook is called both when the mode is enabled and when it is -disabled. - -Suspicious constructs are highlighted using `font-lock-warning-face'. - -Note, in addition to enabling this minor mode, the major mode must -be included in the variable `cwarn-configuration'. By default C and -C++ modes are included. +The mode's hook is called both when the mode is enabled and when +it is disabled. \(fn &optional ARG)" t nil) @@ -7243,20 +7257,6 @@ or call the function `delete-selection-mode'.") (autoload 'delete-selection-mode "delsel" "\ Toggle Delete Selection mode. -This is a minor mode. If called interactively, toggle the -`Delete-Selection mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. - -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. - -To check whether the minor mode is enabled in the current buffer, -evaluate `(default-value \\='delete-selection-mode)'. - -The mode's hook is called both when the mode is enabled and when it is -disabled. - When Delete Selection mode is enabled, typed text replaces the selection if the selection is active. Otherwise, typed text is just inserted at point regardless of any selection. @@ -7264,6 +7264,21 @@ point regardless of any selection. See `delete-selection-helper' and `delete-selection-pre-hook' for information on adapting behavior of commands in Delete Selection mode. +This is a global minor mode. If called interactively, toggle the +`Delete-Selection mode' mode. If the prefix argument is +positive, enable the mode, and if it is zero or negative, disable +the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. + +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value \\='delete-selection-mode)'. + +The mode's hook is called both when the mode is enabled and when +it is disabled. + \(fn &optional ARG)" t nil) (autoload 'delete-active-region "delsel" "\ @@ -7433,20 +7448,6 @@ or call the function `desktop-save-mode'.") (autoload 'desktop-save-mode "desktop" "\ Toggle desktop saving (Desktop Save mode). -This is a minor mode. If called interactively, toggle the -`Desktop-Save mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. - -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. - -To check whether the minor mode is enabled in the current buffer, -evaluate `(default-value \\='desktop-save-mode)'. - -The mode's hook is called both when the mode is enabled and when it is -disabled. - When Desktop Save mode is enabled, the state of Emacs is saved from one session to another. In particular, Emacs will save the desktop when it exits (this may prompt you; see the option `desktop-save'). The next @@ -7462,6 +7463,20 @@ To see all the options you can set, browse the `desktop' customization group. For further details, see info node `(emacs)Saving Emacs Sessions'. +This is a global minor mode. If called interactively, toggle the +`Desktop-Save mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. + +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value \\='desktop-save-mode)'. + +The mode's hook is called both when the mode is enabled and when +it is disabled. + \(fn &optional ARG)" t nil) (defvar desktop-locals-to-save '(desktop-locals-to-save truncate-lines case-fold-search case-replace fill-column overwrite-mode change-log-default-name line-number-mode column-number-mode size-indication-mode buffer-file-coding-system buffer-display-time indent-tabs-mode tab-width indicate-buffer-boundaries indicate-empty-lines show-trailing-whitespace) "\ @@ -7897,6 +7912,8 @@ diff command. OLD and NEW may each be a buffer or a buffer name. +Also see the `diff-entire-buffers' variable. + \(fn OLD NEW &optional SWITCHES NO-ASYNC)" t nil) (register-definition-prefixes "diff" '("diff-")) @@ -7926,21 +7943,21 @@ a diff with \\[diff-reverse-direction]. (autoload 'diff-minor-mode "diff-mode" "\ Toggle Diff minor mode. -This is a minor mode. If called interactively, toggle the `Diff minor -mode' mode. If the prefix argument is positive, enable the mode, and -if it is zero or negative, disable the mode. +\\{diff-minor-mode-map} + +This is a minor mode. If called interactively, toggle the `Diff +minor mode' mode. If the prefix argument is positive, enable the +mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `diff-minor-mode'. -The mode's hook is called both when the mode is enabled and when it is -disabled. - -\\{diff-minor-mode-map} +The mode's hook is called both when the mode is enabled and when +it is disabled. \(fn &optional ARG)" t nil) @@ -7995,8 +8012,11 @@ The directory name must be absolute, but need not be fully expanded.") (autoload 'dired "dired" "\ \"Edit\" directory DIRNAME--delete, rename, print, etc. some files in it. -Optional second argument SWITCHES specifies the `ls' options used. -\(Interactively, use a prefix argument to be able to specify SWITCHES.) +Optional second argument SWITCHES specifies the options to be used +when invoking `insert-directory-program', usually `ls', which produces +the listing of the directory files and their attributes. +Interactively, a prefix argument will cause the command to prompt +for SWITCHES. If DIRNAME is a string, Dired displays a list of files in DIRNAME (which may also have shell wildcards appended to select certain files). @@ -8124,20 +8144,6 @@ Like \\[dired-jump] (`dired-jump') but in other window. (autoload 'dirtrack-mode "dirtrack" "\ Toggle directory tracking in shell buffers (Dirtrack mode). -This is a minor mode. If called interactively, toggle the `Dirtrack -mode' mode. If the prefix argument is positive, enable the mode, and -if it is zero or negative, disable the mode. - -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. - -To check whether the minor mode is enabled in the current buffer, -evaluate `dirtrack-mode'. - -The mode's hook is called both when the mode is enabled and when it is -disabled. - This method requires that your shell prompt contain the current working directory at all times, and that you set the variable `dirtrack-list' to match the prompt. @@ -8146,6 +8152,20 @@ This is an alternative to `shell-dirtrack-mode', which works by tracking `cd' and similar commands which change the shell working directory. +This is a minor mode. If called interactively, toggle the +`Dirtrack mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. + +To check whether the minor mode is enabled in the current buffer, +evaluate `dirtrack-mode'. + +The mode's hook is called both when the mode is enabled and when +it is disabled. + \(fn &optional ARG)" t nil) (autoload 'dirtrack "dirtrack" "\ @@ -8302,22 +8322,8 @@ in `.emacs'. (autoload 'display-fill-column-indicator-mode "display-fill-column-indicator" "\ Toggle display of `fill-column' indicator. -This uses `display-fill-column-indicator' internally. - -This is a minor mode. If called interactively, toggle the -`Display-Fill-Column-Indicator mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable the -mode. - -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. - -To check whether the minor mode is enabled in the current buffer, -evaluate `display-fill-column-indicator-mode'. -The mode's hook is called both when the mode is enabled and when it is -disabled. +This uses `display-fill-column-indicator' internally. To change the position of the column displayed by default customize `display-fill-column-indicator-column'. You can change the @@ -8326,6 +8332,21 @@ The globalized version is `global-display-fill-column-indicator-mode', which see. See Info node `Displaying Boundaries' for details. +This is a minor mode. If called interactively, toggle the +`Display-Fill-Column-Indicator mode' mode. If the prefix +argument is positive, enable the mode, and if it is zero or +negative, disable the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. + +To check whether the minor mode is enabled in the current buffer, +evaluate `display-fill-column-indicator-mode'. + +The mode's hook is called both when the mode is enabled and when +it is disabled. + \(fn &optional ARG)" t nil) (put 'global-display-fill-column-indicator-mode 'globalized-minor-mode t) @@ -8386,25 +8407,27 @@ list.") (autoload 'display-line-numbers-mode "display-line-numbers" "\ Toggle display of line numbers in the buffer. + This uses `display-line-numbers' internally. +To change the type of line numbers displayed by default, +customize `display-line-numbers-type'. To change the type while +the mode is on, set `display-line-numbers' directly. + This is a minor mode. If called interactively, toggle the -`Display-Line-Numbers mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +`Display-Line-Numbers mode' mode. If the prefix argument is +positive, enable the mode, and if it is zero or negative, disable +the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `display-line-numbers-mode'. -The mode's hook is called both when the mode is enabled and when it is -disabled. - -To change the type of line numbers displayed by default, -customize `display-line-numbers-type'. To change the type while -the mode is on, set `display-line-numbers' directly. +The mode's hook is called both when the mode is enabled and when +it is disabled. \(fn &optional ARG)" t nil) @@ -8544,21 +8567,21 @@ to the next best mode." nil nil) (autoload 'doc-view-minor-mode "doc-view" "\ Toggle displaying buffer via Doc View (Doc View minor mode). -This is a minor mode. If called interactively, toggle the `Doc-View -minor mode' mode. If the prefix argument is positive, enable the -mode, and if it is zero or negative, disable the mode. +See the command `doc-view-mode' for more information on this mode. + +This is a minor mode. If called interactively, toggle the +`Doc-View minor mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `doc-view-minor-mode'. -The mode's hook is called both when the mode is enabled and when it is -disabled. - -See the command `doc-view-mode' for more information on this mode. +The mode's hook is called both when the mode is enabled and when +it is disabled. \(fn &optional ARG)" t nil) @@ -8615,22 +8638,22 @@ Switch to *doctor* buffer and start giving psychotherapy." t nil) (autoload 'double-mode "double" "\ Toggle special insertion on double keypresses (Double mode). -This is a minor mode. If called interactively, toggle the `Double -mode' mode. If the prefix argument is positive, enable the mode, and -if it is zero or negative, disable the mode. +When Double mode is enabled, some keys will insert different +strings when pressed twice. See `double-map' for details. + +This is a minor mode. If called interactively, toggle the +`Double mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `double-mode'. -The mode's hook is called both when the mode is enabled and when it is -disabled. - -When Double mode is enabled, some keys will insert different -strings when pressed twice. See `double-map' for details. +The mode's hook is called both when the mode is enabled and when +it is disabled. \(fn &optional ARG)" t nil) @@ -9325,22 +9348,22 @@ or call the function `global-ede-mode'.") (autoload 'global-ede-mode "ede" "\ Toggle global EDE (Emacs Development Environment) mode. -This is a minor mode. If called interactively, toggle the `Global Ede -mode' mode. If the prefix argument is positive, enable the mode, and -if it is zero or negative, disable the mode. +This global minor mode enables `ede-minor-mode' in all buffers in +an EDE controlled project. + +This is a global minor mode. If called interactively, toggle the +`Global Ede mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='global-ede-mode)'. -The mode's hook is called both when the mode is enabled and when it is -disabled. - -This global minor mode enables `ede-minor-mode' in all buffers in -an EDE controlled project. +The mode's hook is called both when the mode is enabled and when +it is disabled. \(fn &optional ARG)" t nil) @@ -10170,7 +10193,7 @@ It creates an autoload function for CNAME's constructor. ;;;### (autoloads nil "eldoc" "emacs-lisp/eldoc.el" (0 0 0 0)) ;;; Generated autoloads from emacs-lisp/eldoc.el -(push (purecopy '(eldoc 1 11 0)) package--builtin-versions) +(push (purecopy '(eldoc 1 11 1)) package--builtin-versions) ;;;*** @@ -10190,20 +10213,6 @@ or call the function `electric-pair-mode'.") (autoload 'electric-pair-mode "elec-pair" "\ Toggle automatic parens pairing (Electric Pair mode). -This is a minor mode. If called interactively, toggle the -`Electric-Pair mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. - -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. - -To check whether the minor mode is enabled in the current buffer, -evaluate `(default-value \\='electric-pair-mode)'. - -The mode's hook is called both when the mode is enabled and when it is -disabled. - Electric Pair mode is a global minor mode. When enabled, typing an open parenthesis automatically inserts the corresponding closing parenthesis, and vice versa. (Likewise for brackets, etc.). @@ -10212,25 +10221,40 @@ inserted around the region instead. To toggle the mode in a single buffer, use `electric-pair-local-mode'. +This is a global minor mode. If called interactively, toggle the +`Electric-Pair mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. + +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value \\='electric-pair-mode)'. + +The mode's hook is called both when the mode is enabled and when +it is disabled. + \(fn &optional ARG)" t nil) (autoload 'electric-pair-local-mode "elec-pair" "\ Toggle `electric-pair-mode' only in this buffer. This is a minor mode. If called interactively, toggle the -`Electric-Pair-Local mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +`Electric-Pair-Local mode' mode. If the prefix argument is +positive, enable the mode, and if it is zero or negative, disable +the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(buffer-local-value \\='electric-pair-mode \(current-buffer))'. -The mode's hook is called both when the mode is enabled and when it is -disabled. +The mode's hook is called both when the mode is enabled and when +it is disabled. \(fn &optional ARG)" t nil) @@ -10244,26 +10268,26 @@ disabled. (autoload 'elide-head-mode "elide-head" "\ Toggle eliding (hiding) header material in the current buffer. -This is a minor mode. If called interactively, toggle the `Elide-Head -mode' mode. If the prefix argument is positive, enable the mode, and -if it is zero or negative, disable the mode. - -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. - -To check whether the minor mode is enabled in the current buffer, -evaluate `elide-head-mode'. - -The mode's hook is called both when the mode is enabled and when it is -disabled. - When Elide Header mode is enabled, headers are hidden according to `elide-head-headers-to-hide'. This is suitable as an entry on `find-file-hook' or appropriate mode hooks. +This is a minor mode. If called interactively, toggle the +`Elide-Head mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. + +To check whether the minor mode is enabled in the current buffer, +evaluate `elide-head-mode'. + +The mode's hook is called both when the mode is enabled and when +it is disabled. + \(fn &optional ARG)" t nil) (autoload 'elide-head "elide-head" "\ @@ -10359,7 +10383,7 @@ displayed." t nil) ;;;;;; 0)) ;;; Generated autoloads from eshell/em-extpipe.el -(register-definition-prefixes "em-extpipe" '("eshell-")) +(register-definition-prefixes "em-extpipe" '("em-extpipe--or-with-catch" "eshell-")) ;;;*** @@ -10393,6 +10417,24 @@ some major modes from being locked under some circumstances. ;;;*** +;;;### (autoloads nil "emacs-news-mode" "textmodes/emacs-news-mode.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from textmodes/emacs-news-mode.el + +(autoload 'emacs-news-mode "emacs-news-mode" "\ +Major mode for editing the Emacs NEWS file. + +\(fn)" t nil) + +(autoload 'emacs-news-view-mode "emacs-news-mode" "\ +Major mode for viewing the Emacs NEWS file. + +\(fn)" t nil) + +(register-definition-prefixes "emacs-news-mode" '("emacs-news-")) + +;;;*** + ;;;### (autoloads nil "emacsbug" "mail/emacsbug.el" (0 0 0 0)) ;;; Generated autoloads from mail/emacsbug.el @@ -10522,23 +10564,10 @@ the name is not known. (autoload 'enriched-mode "enriched" "\ Minor mode for editing text/enriched files. + These are files with embedded formatting information in the MIME standard text/enriched format. -This is a minor mode. If called interactively, toggle the `Enriched -mode' mode. If the prefix argument is positive, enable the mode, and -if it is zero or negative, disable the mode. - -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. - -To check whether the minor mode is enabled in the current buffer, -evaluate `enriched-mode'. - -The mode's hook is called both when the mode is enabled and when it is -disabled. - Turning the mode on or off runs `enriched-mode-hook'. More information about Enriched mode is available in the file @@ -10548,6 +10577,20 @@ Commands: \\{enriched-mode-map} +This is a minor mode. If called interactively, toggle the +`Enriched mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. + +To check whether the minor mode is enabled in the current buffer, +evaluate `enriched-mode'. + +The mode's hook is called both when the mode is enabled and when +it is disabled. + \(fn &optional ARG)" t nil) (autoload 'enriched-encode "enriched" "\ @@ -10811,19 +10854,19 @@ enough, since keyservers have strict timeout settings. (autoload 'epa-mail-mode "epa-mail" "\ A minor-mode for composing encrypted/clearsigned mails. -This is a minor mode. If called interactively, toggle the `epa-mail -mode' mode. If the prefix argument is positive, enable the mode, and -if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the +`epa-mail mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `epa-mail-mode'. -The mode's hook is called both when the mode is enabled and when it is -disabled. +The mode's hook is called both when the mode is enabled and when +it is disabled. \(fn &optional ARG)" t nil) @@ -10884,19 +10927,19 @@ or call the function `epa-global-mail-mode'.") (autoload 'epa-global-mail-mode "epa-mail" "\ Minor mode to hook EasyPG into Mail mode. -This is a minor mode. If called interactively, toggle the +This is a global minor mode. If called interactively, toggle the `Epa-Global-Mail mode' mode. If the prefix argument is positive, enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='epa-global-mail-mode)'. -The mode's hook is called both when the mode is enabled and when it is -disabled. +The mode's hook is called both when the mode is enabled and when +it is disabled. \(fn &optional ARG)" t nil) @@ -11024,7 +11067,7 @@ Example usage: (erc-tls :server \"irc.libera.chat\" :port 6697 :client-certificate - '(\"/home/bandali/my-cert.key\" + \\='(\"/home/bandali/my-cert.key\" \"/home/bandali/my-cert.crt\")) \(fn &key (SERVER (erc-compute-server)) (PORT (erc-compute-port)) (NICK (erc-compute-nick)) PASSWORD (FULL-NAME (erc-compute-full-name)) CLIENT-CERTIFICATE)" t nil) @@ -11826,13 +11869,18 @@ non-nil, collect results from all servers. \(fn &optional SAVE-QUERY-AS-KILL TRY-ALL-SERVERS)" t nil) +(autoload 'eudc-format-inline-expansion-result "eudc" "\ +Format a query result according to `eudc-inline-expansion-format'. + +\(fn RES QUERY-ATTRS)" nil nil) + (autoload 'eudc-query-with-words "eudc" "\ Query the directory server, and return the matching responses. The variable `eudc-inline-query-format' controls how to associate the individual QUERY-WORDS with directory attribute names. After querying the server for the given string, the expansion specified by `eudc-inline-expansion-format' is applied to the -matches before returning them.inserted in the buffer at point. +matches before returning them. Multiple servers can be tried with the same query until one finds a match, see `eudc-inline-expansion-servers'. When TRY-ALL-SERVERS is non-nil, keep collecting results from subsequent servers after the first match. @@ -12356,22 +12404,22 @@ Adjust the height of the default face by the scale in the pinch event EVENT. (autoload 'buffer-face-mode "face-remap" "\ Minor mode for a buffer-specific default face. +When enabled, the face specified by the variable +`buffer-face-mode-face' is used to display the buffer text. + This is a minor mode. If called interactively, toggle the -`Buffer-Face mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. +`Buffer-Face mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `buffer-face-mode'. -The mode's hook is called both when the mode is enabled and when it is -disabled. - -When enabled, the face specified by the variable -`buffer-face-mode-face' is used to display the buffer text. +The mode's hook is called both when the mode is enabled and when +it is disabled. \(fn &optional ARG)" t nil) @@ -13323,20 +13371,6 @@ region is invalid. This function saves match data. (autoload 'flymake-mode "flymake" "\ Toggle Flymake mode on or off. -This is a minor mode. If called interactively, toggle the `Flymake -mode' mode. If the prefix argument is positive, enable the mode, and -if it is zero or negative, disable the mode. - -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. - -To check whether the minor mode is enabled in the current buffer, -evaluate `flymake-mode'. - -The mode's hook is called both when the mode is enabled and when it is -disabled. - Flymake is an Emacs minor mode for on-the-fly syntax checking. Flymake collects diagnostic information from multiple sources, called backends, and visually annotates the buffer with the @@ -13367,6 +13401,20 @@ suitable for the current buffer. The commands `flymake-reporting-backends' summarize the situation, as does the special *Flymake log* buffer. +This is a minor mode. If called interactively, toggle the +`Flymake mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. + +To check whether the minor mode is enabled in the current buffer, +evaluate `flymake-mode'. + +The mode's hook is called both when the mode is enabled and when +it is disabled. + \(fn &optional ARG)" t nil) (autoload 'flymake-mode-on "flymake" "\ @@ -13414,20 +13462,6 @@ Turn on `flyspell-mode' for comments and strings." t nil) (autoload 'flyspell-mode "flyspell" "\ Toggle on-the-fly spell checking (Flyspell mode). -This is a minor mode. If called interactively, toggle the `Flyspell -mode' mode. If the prefix argument is positive, enable the mode, and -if it is zero or negative, disable the mode. - -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. - -To check whether the minor mode is enabled in the current buffer, -evaluate `flyspell-mode'. - -The mode's hook is called both when the mode is enabled and when it is -disabled. - Flyspell mode is a buffer-local minor mode. When enabled, it spawns a single Ispell process and checks each word. The default flyspell behavior is to highlight incorrect words. @@ -13457,6 +13491,20 @@ in your init file. \\[flyspell-region] checks all words inside a region. \\[flyspell-buffer] checks the whole buffer. +This is a minor mode. If called interactively, toggle the +`Flyspell mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. + +To check whether the minor mode is enabled in the current buffer, +evaluate `flyspell-mode'. + +The mode's hook is called both when the mode is enabled and when +it is disabled. + \(fn &optional ARG)" t nil) (autoload 'turn-on-flyspell "flyspell" "\ @@ -13503,20 +13551,6 @@ Turn off Follow mode. Please see the function `follow-mode'." nil nil) (autoload 'follow-mode "follow" "\ Toggle Follow mode. -This is a minor mode. If called interactively, toggle the `Follow -mode' mode. If the prefix argument is positive, enable the mode, and -if it is zero or negative, disable the mode. - -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. - -To check whether the minor mode is enabled in the current buffer, -evaluate `follow-mode'. - -The mode's hook is called both when the mode is enabled and when it is -disabled. - Follow mode is a minor mode that combines windows into one tall virtual window. This is accomplished by two main techniques: @@ -13546,6 +13580,20 @@ This command runs the normal hook `follow-mode-hook'. Keys specific to Follow mode: \\{follow-mode-map} +This is a minor mode. If called interactively, toggle the +`Follow mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. + +To check whether the minor mode is enabled in the current buffer, +evaluate `follow-mode'. + +The mode's hook is called both when the mode is enabled and when +it is disabled. + \(fn &optional ARG)" t nil) (autoload 'follow-scroll-up-window "follow" "\ @@ -13636,24 +13684,24 @@ selected if the original window is the first one in the frame. (autoload 'footnote-mode "footnote" "\ Toggle Footnote mode. -This is a minor mode. If called interactively, toggle the `Footnote -mode' mode. If the prefix argument is positive, enable the mode, and -if it is zero or negative, disable the mode. +Footnote mode is a buffer-local minor mode. If enabled, it +provides footnote support for `message-mode'. To get started, +play around with the following keys: +\\{footnote-minor-mode-map} + +This is a minor mode. If called interactively, toggle the +`Footnote mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `footnote-mode'. -The mode's hook is called both when the mode is enabled and when it is -disabled. - -Footnote mode is a buffer-local minor mode. If enabled, it -provides footnote support for `message-mode'. To get started, -play around with the following keys: -\\{footnote-minor-mode-map} +The mode's hook is called both when the mode is enabled and when +it is disabled. \(fn &optional ARG)" t nil) @@ -14104,25 +14152,27 @@ for a description of this minor mode.") (autoload 'gdb-enable-debug "gdb-mi" "\ Toggle logging of transaction between Emacs and Gdb. + The log is stored in `gdb-debug-log' as an alist with elements whose cons is send, send-item or recv and whose cdr is the string being transferred. This list may grow up to a size of `gdb-debug-log-max' after which the oldest element (at the end of the list) is deleted every time a new one is added (at the front). -This is a minor mode. If called interactively, toggle the -`Gdb-Enable-Debug mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +This is a global minor mode. If called interactively, toggle the +`Gdb-Enable-Debug mode' mode. If the prefix argument is +positive, enable the mode, and if it is zero or negative, disable +the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='gdb-enable-debug)'. -The mode's hook is called both when the mode is enabled and when it is -disabled. +The mode's hook is called both when the mode is enabled and when +it is disabled. \(fn &optional ARG)" t nil) @@ -14297,22 +14347,22 @@ regular expression that can be used as an element of (autoload 'glasses-mode "glasses" "\ Minor mode for making identifiers likeThis readable. -This is a minor mode. If called interactively, toggle the `Glasses -mode' mode. If the prefix argument is positive, enable the mode, and -if it is zero or negative, disable the mode. +When this mode is active, it tries to add virtual +separators (like underscores) at places they belong to. + +This is a minor mode. If called interactively, toggle the +`Glasses mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `glasses-mode'. -The mode's hook is called both when the mode is enabled and when it is -disabled. - -When this mode is active, it tries to add virtual -separators (like underscores) at places they belong to. +The mode's hook is called both when the mode is enabled and when +it is disabled. \(fn &optional ARG)" t nil) @@ -14326,22 +14376,24 @@ separators (like underscores) at places they belong to. (autoload 'glyphless-display-mode "glyphless-mode" "\ Minor mode for displaying glyphless characters in the current buffer. + If enabled, all glyphless characters will be displayed as boxes that display their acronyms. This is a minor mode. If called interactively, toggle the -`Glyphless-Display mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +`Glyphless-Display mode' mode. If the prefix argument is +positive, enable the mode, and if it is zero or negative, disable +the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `glyphless-display-mode'. -The mode's hook is called both when the mode is enabled and when it is -disabled. +The mode's hook is called both when the mode is enabled and when +it is disabled. \(fn &optional ARG)" t nil) @@ -14945,21 +14997,22 @@ If FORCE is non-nil, replace the old ones. (autoload 'gnus-mailing-list-mode "gnus-ml" "\ Minor mode for providing mailing-list commands. +\\{gnus-mailing-list-mode-map} + This is a minor mode. If called interactively, toggle the -`Gnus-Mailing-List mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +`Gnus-Mailing-List mode' mode. If the prefix argument is +positive, enable the mode, and if it is zero or negative, disable +the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `gnus-mailing-list-mode'. -The mode's hook is called both when the mode is enabled and when it is -disabled. - -\\{gnus-mailing-list-mode-map} +The mode's hook is called both when the mode is enabled and when +it is disabled. \(fn &optional ARG)" t nil) @@ -15417,18 +15470,18 @@ Also fontifies the buffer appropriately (see `goto-address-fontify-p' and Minor mode to buttonize URLs and e-mail addresses in the current buffer. This is a minor mode. If called interactively, toggle the -`Goto-Address mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. +`Goto-Address mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `goto-address-mode'. -The mode's hook is called both when the mode is enabled and when it is -disabled. +The mode's hook is called both when the mode is enabled and when +it is disabled. \(fn &optional ARG)" t nil) @@ -15464,18 +15517,19 @@ See `goto-address-mode' for more information on Goto-Address mode. Like `goto-address-mode', but only for comments and strings. This is a minor mode. If called interactively, toggle the -`Goto-Address-Prog mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +`Goto-Address-Prog mode' mode. If the prefix argument is +positive, enable the mode, and if it is zero or negative, disable +the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `goto-address-prog-mode'. -The mode's hook is called both when the mode is enabled and when it is -disabled. +The mode's hook is called both when the mode is enabled and when +it is disabled. \(fn &optional ARG)" t nil) @@ -15587,8 +15641,8 @@ Set up `compilation-exit-message-function' and run `grep-setup-hook'." nil nil) Compute the defaults for the `grep' command. The value depends on `grep-command', `grep-template', `grep-use-null-device', `grep-find-command', `grep-find-template', -`grep-use-null-filename-separator', `grep-find-use-xargs' and -`grep-highlight-matches'." nil nil) +`grep-use-null-filename-separator', `grep-find-use-xargs', +`grep-highlight-matches', and `grep-quoting-style'." nil nil) (autoload 'grep-mode "grep" "\ Sets `grep-last-buffer' and `compilation-window-height'. @@ -15630,7 +15684,7 @@ easily repeat a find command. \(fn COMMAND-ARGS)" t nil) -(defalias 'find-grep 'grep-find) +(defalias 'find-grep #'grep-find) (autoload 'lgrep "grep" "\ Run grep, searching for REGEXP in FILES in directory DIR. @@ -15692,7 +15746,7 @@ command before it's run. \(fn REGEXP &optional FILES DIR CONFIRM TEMPLATE)" t nil) -(defalias 'rzgrep 'zrgrep) +(defalias 'rzgrep #'zrgrep) (register-definition-prefixes "grep" '("grep-" "kill-grep" "rgrep-")) @@ -15811,19 +15865,19 @@ or call the function `gud-tooltip-mode'.") (autoload 'gud-tooltip-mode "gud" "\ Toggle the display of GUD tooltips. -This is a minor mode. If called interactively, toggle the -`Gud-Tooltip mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. +This is a global minor mode. If called interactively, toggle the +`Gud-Tooltip mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='gud-tooltip-mode)'. -The mode's hook is called both when the mode is enabled and when it is -disabled. +The mode's hook is called both when the mode is enabled and when +it is disabled. \(fn &optional ARG)" t nil) @@ -16056,19 +16110,22 @@ If this produces no string either, return nil." nil nil) (autoload 'display-local-help "help-at-pt" "\ Display local help in the echo area. -This displays a short help message, namely the string produced by -the `kbd-help' property at point. If `kbd-help' does not produce -a string, but the `help-echo' property does, then that string is -printed instead. +This command, by default, displays a short help message, namely +the string produced by the `kbd-help' property at point. If +`kbd-help' does not produce a string, but the `help-echo' +property does, then that string is printed instead. The string is passed through `substitute-command-keys' before it is displayed. -A numeric argument ARG prevents display of a message in case -there is no help. While ARG can be used interactively, it is -mainly meant for use from Lisp. +If INHIBIT-WARNING is non-nil, this prevents display of a message +in case there is no help. -\(fn &optional ARG)" t nil) +If DESCRIBE-BUTTON in non-nil (interactively, the prefix arg), and +there's a button/widget at point, pop a buffer describing that +button/widget instead. + +\(fn &optional INHIBIT-WARNING DESCRIBE-BUTTON)" t nil) (autoload 'help-at-pt-cancel-timer "help-at-pt" "\ Cancel any timer set by `help-at-pt-set-timer'. @@ -16344,7 +16401,8 @@ gives the window that lists the options.") (autoload 'help-mode "help-mode" "\ Major mode for viewing help text and navigating references in it. -Entry to this mode runs the normal hook `help-mode-hook'. +Also see the `help-enable-editing' variable. + Commands: \\{help-mode-map} @@ -16565,20 +16623,6 @@ This discards the buffer's undo information." t nil) (autoload 'hi-lock-mode "hi-lock" "\ Toggle selective highlighting of patterns (Hi Lock mode). -This is a minor mode. If called interactively, toggle the `Hi-Lock -mode' mode. If the prefix argument is positive, enable the mode, and -if it is zero or negative, disable the mode. - -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. - -To check whether the minor mode is enabled in the current buffer, -evaluate `hi-lock-mode'. - -The mode's hook is called both when the mode is enabled and when it is -disabled. - Hi Lock mode is automatically enabled when you invoke any of the highlighting commands listed below, such as \\[highlight-regexp]. To enable Hi Lock mode in all buffers, use `global-hi-lock-mode' @@ -16639,6 +16683,20 @@ position (number of characters into buffer) Hi-lock: end is found. A mode is excluded if it's in the list `hi-lock-exclude-modes'. +This is a minor mode. If called interactively, toggle the +`Hi-Lock mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. + +To check whether the minor mode is enabled in the current buffer, +evaluate `hi-lock-mode'. + +The mode's hook is called both when the mode is enabled and when +it is disabled. + \(fn &optional ARG)" t nil) (put 'global-hi-lock-mode 'globalized-minor-mode t) @@ -16787,20 +16845,6 @@ Populate MENU with a menu item to highlight symbol at CLICK. (autoload 'hide-ifdef-mode "hideif" "\ Toggle features to hide/show #ifdef blocks (Hide-Ifdef mode). -This is a minor mode. If called interactively, toggle the `Hide-Ifdef -mode' mode. If the prefix argument is positive, enable the mode, and -if it is zero or negative, disable the mode. - -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. - -To check whether the minor mode is enabled in the current buffer, -evaluate `hide-ifdef-mode'. - -The mode's hook is called both when the mode is enabled and when it is -disabled. - Hide-Ifdef mode is a buffer-local minor mode for use with C and C-like major modes. When enabled, code within #ifdef constructs that the C preprocessor would eliminate may be hidden from view. @@ -16835,6 +16879,20 @@ Several variables affect how the hiding is done: \\{hide-ifdef-mode-map} +This is a minor mode. If called interactively, toggle the +`Hide-Ifdef mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. + +To check whether the minor mode is enabled in the current buffer, +evaluate `hide-ifdef-mode'. + +The mode's hook is called both when the mode is enabled and when +it is disabled. + \(fn &optional ARG)" t nil) (register-definition-prefixes "hideif" '("backward-ifdef" "down-ifdef" "forward-ifdef" "hide-ifdef" "hif-" "intern-safe" "next-ifdef" "previous-ifdef" "show-ifdef" "up-ifdef")) @@ -16875,20 +16933,6 @@ whitespace. Case does not matter.") (autoload 'hs-minor-mode "hideshow" "\ Minor mode to selectively hide/show code and comment blocks. -This is a minor mode. If called interactively, toggle the `hs minor -mode' mode. If the prefix argument is positive, enable the mode, and -if it is zero or negative, disable the mode. - -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. - -To check whether the minor mode is enabled in the current buffer, -evaluate `hs-minor-mode'. - -The mode's hook is called both when the mode is enabled and when it is -disabled. - When hideshow minor mode is on, the menu bar is augmented with hideshow commands and the hideshow commands are enabled. The value (hs . t) is added to `buffer-invisibility-spec'. @@ -16905,6 +16949,20 @@ Lastly, the normal hook `hs-minor-mode-hook' is run using `run-hooks'. Key bindings: \\{hs-minor-mode-map} +This is a minor mode. If called interactively, toggle the `hs +minor mode' mode. If the prefix argument is positive, enable the +mode, and if it is zero or negative, disable the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. + +To check whether the minor mode is enabled in the current buffer, +evaluate `hs-minor-mode'. + +The mode's hook is called both when the mode is enabled and when +it is disabled. + \(fn &optional ARG)" t nil) (autoload 'turn-off-hideshow "hideshow" "\ @@ -16928,20 +16986,6 @@ Unconditionally turn off `hs-minor-mode'." nil nil) (autoload 'highlight-changes-mode "hilit-chg" "\ Toggle highlighting changes in this buffer (Highlight Changes mode). -This is a minor mode. If called interactively, toggle the -`Highlight-Changes mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. - -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. - -To check whether the minor mode is enabled in the current buffer, -evaluate `highlight-changes-mode'. - -The mode's hook is called both when the mode is enabled and when it is -disabled. - When Highlight Changes is enabled, changes are marked with a text property. Normally they are displayed in a distinctive face, but command \\[highlight-changes-visible-mode] can be used to toggle @@ -16957,25 +17001,25 @@ through various faces. buffer with the contents of a file \\[highlight-compare-buffers] highlights differences between two buffers. -\(fn &optional ARG)" t nil) - -(autoload 'highlight-changes-visible-mode "hilit-chg" "\ -Toggle visibility of highlighting due to Highlight Changes mode. - This is a minor mode. If called interactively, toggle the -`Highlight-Changes-Visible mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable the -mode. +`Highlight-Changes mode' mode. If the prefix argument is +positive, enable the mode, and if it is zero or negative, disable +the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, -evaluate `highlight-changes-visible-mode'. +evaluate `highlight-changes-mode'. + +The mode's hook is called both when the mode is enabled and when +it is disabled. + +\(fn &optional ARG)" t nil) -The mode's hook is called both when the mode is enabled and when it is -disabled. +(autoload 'highlight-changes-visible-mode "hilit-chg" "\ +Toggle visibility of highlighting due to Highlight Changes mode. Highlight Changes Visible mode only has an effect when Highlight Changes mode is on. When enabled, the changed text is displayed @@ -16986,6 +17030,21 @@ The default value can be customized with variable This command does not itself set Highlight Changes mode. +This is a minor mode. If called interactively, toggle the +`Highlight-Changes-Visible mode' mode. If the prefix argument is +positive, enable the mode, and if it is zero or negative, disable +the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. + +To check whether the minor mode is enabled in the current buffer, +evaluate `highlight-changes-visible-mode'. + +The mode's hook is called both when the mode is enabled and when +it is disabled. + \(fn &optional ARG)" t nil) (autoload 'highlight-changes-remove-highlight "hilit-chg" "\ @@ -17117,26 +17176,34 @@ argument VERBOSE non-nil makes the function verbose. ;;; Generated autoloads from hl-line.el (autoload 'hl-line-mode "hl-line" "\ -Toggle highlighting of the current line. +Toggle highlighting of the current line (Hl-Line mode). + +Hl-Line mode is a buffer-local minor mode. If +`hl-line-sticky-flag' is non-nil, Hl-Line mode highlights the +line about the buffer's point in all windows. Caveat: the +buffer's point might be different from the point of a +non-selected window. Hl-Line mode uses the function +`hl-line-highlight' on `post-command-hook' in this case. -This is a minor mode. If called interactively, toggle the `Hl-Line -mode' mode. If the prefix argument is positive, enable the mode, and -if it is zero or negative, disable the mode. +When `hl-line-sticky-flag' is nil, Hl-Line mode highlights the +line about point in the selected window only. + +This is a minor mode. If called interactively, toggle the +`Hl-Line mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `hl-line-mode'. -The mode's hook is called both when the mode is enabled and when it is -disabled. +The mode's hook is called both when the mode is enabled and when +it is disabled. \(fn &optional ARG)" t nil) -(put 'global-hl-line-mode 'globalized-minor-mode t) - (defvar global-hl-line-mode nil "\ Non-nil if Global Hl-Line mode is enabled. See the `global-hl-line-mode' command @@ -17148,22 +17215,32 @@ or call the function `global-hl-line-mode'.") (custom-autoload 'global-hl-line-mode "hl-line" nil) (autoload 'global-hl-line-mode "hl-line" "\ -Toggle Hl-Line mode in all buffers. -With prefix ARG, enable Global Hl-Line mode if ARG is positive; -otherwise, disable it. +Toggle line highlighting in all buffers (Global Hl-Line mode). -If called from Lisp, toggle the mode if ARG is `toggle'. -Enable the mode if ARG is nil, omitted, or is a positive number. +If `global-hl-line-sticky-flag' is non-nil, Global Hl-Line mode +highlights the line about the current buffer's point in all live +windows. + +Global-Hl-Line mode uses the function `global-hl-line-highlight' +on `post-command-hook'. + +This is a global minor mode. If called interactively, toggle the +`Global Hl-Line mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. Disable the mode if ARG is a negative number. -Hl-Line mode is enabled in all buffers where `hl-line-turn-on' would -do it. +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value \\='global-hl-line-mode)'. -See `hl-line-mode' for more information on Hl-Line mode. +The mode's hook is called both when the mode is enabled and when +it is disabled. \(fn &optional ARG)" t nil) -(register-definition-prefixes "hl-line" '("hl-line-")) +(register-definition-prefixes "hl-line" '("global-hl-line-" "hl-line-")) ;;;*** @@ -17285,6 +17362,11 @@ of a holiday list. The optional LABEL is used to label the buffer created. +The list of holiday lists is computed by the +`holiday-available-holiday-lists' and you can alter the results +by redefining that function, or use `add-function' to add +values. + \(fn Y1 &optional Y2 L LABEL)" t nil) (defalias 'holiday-list 'list-holidays) @@ -17561,22 +17643,22 @@ or call the function `fido-mode'.") (autoload 'fido-mode "icomplete" "\ An enhanced `icomplete-mode' that emulates `ido-mode'. -This is a minor mode. If called interactively, toggle the `Fido mode' -mode. If the prefix argument is positive, enable the mode, and if it -is zero or negative, disable the mode. +This global minor mode makes minibuffer completion behave +more like `ido-mode' than regular `icomplete-mode'. + +This is a global minor mode. If called interactively, toggle the +`Fido mode' mode. If the prefix argument is positive, enable the +mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='fido-mode)'. -The mode's hook is called both when the mode is enabled and when it is -disabled. - -This global minor mode makes minibuffer completion behave -more like `ido-mode' than regular `icomplete-mode'. +The mode's hook is called both when the mode is enabled and when +it is disabled. \(fn &optional ARG)" t nil) @@ -17593,20 +17675,6 @@ or call the function `icomplete-mode'.") (autoload 'icomplete-mode "icomplete" "\ Toggle incremental minibuffer completion (Icomplete mode). -This is a minor mode. If called interactively, toggle the `Icomplete -mode' mode. If the prefix argument is positive, enable the mode, and -if it is zero or negative, disable the mode. - -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. - -To check whether the minor mode is enabled in the current buffer, -evaluate `(default-value \\='icomplete-mode)'. - -The mode's hook is called both when the mode is enabled and when it is -disabled. - When this global minor mode is enabled, typing in the minibuffer continuously displays a list of possible completions that match the string you have typed. See `icomplete-completions' for a @@ -17620,6 +17688,20 @@ completions: \\{icomplete-minibuffer-map} +This is a global minor mode. If called interactively, toggle the +`Icomplete mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. + +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value \\='icomplete-mode)'. + +The mode's hook is called both when the mode is enabled and when +it is disabled. + \(fn &optional ARG)" t nil) (defvar icomplete-vertical-mode nil "\ @@ -17635,26 +17717,27 @@ or call the function `icomplete-vertical-mode'.") (autoload 'icomplete-vertical-mode "icomplete" "\ Toggle vertical candidate display in `icomplete-mode' or `fido-mode'. -This is a minor mode. If called interactively, toggle the -`Icomplete-Vertical mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. - -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. - -To check whether the minor mode is enabled in the current buffer, -evaluate `(default-value \\='icomplete-vertical-mode)'. - -The mode's hook is called both when the mode is enabled and when it is -disabled. - If none of these modes are on, turn on `icomplete-mode'. As many completion candidates as possible are displayed, depending on the value of `max-mini-window-height', and the way the mini-window is resized depends on `resize-mini-windows'. +This is a global minor mode. If called interactively, toggle the +`Icomplete-Vertical mode' mode. If the prefix argument is +positive, enable the mode, and if it is zero or negative, disable +the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. + +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value \\='icomplete-vertical-mode)'. + +The mode's hook is called both when the mode is enabled and when +it is disabled. + \(fn &optional ARG)" t nil) (defvar fido-vertical-mode nil "\ @@ -17669,22 +17752,23 @@ or call the function `fido-vertical-mode'.") (autoload 'fido-vertical-mode "icomplete" "\ Toggle vertical candidate display in `fido-mode'. + When turning on, if non-vertical `fido-mode' is off, turn it on. If it's on, just add the vertical display. -This is a minor mode. If called interactively, toggle the -`Fido-Vertical mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. +This is a global minor mode. If called interactively, toggle the +`Fido-Vertical mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='fido-vertical-mode)'. -The mode's hook is called both when the mode is enabled and when it is -disabled. +The mode's hook is called both when the mode is enabled and when +it is disabled. \(fn &optional ARG)" t nil) (when (locate-library "obsolete/iswitchb") @@ -18218,21 +18302,19 @@ See `inferior-emacs-lisp-mode' for details. (autoload 'iimage-mode "iimage" "\ Toggle Iimage mode on or off. -This is a minor mode. If called interactively, toggle the `Iimage -mode' mode. If the prefix argument is positive, enable the mode, and -if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the +`Iimage mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `iimage-mode'. -The mode's hook is called both when the mode is enabled and when it is -disabled. - -\\{iimage-mode-map} +The mode's hook is called both when the mode is enabled and when +it is disabled. \(fn &optional ARG)" t nil) @@ -18269,6 +18351,16 @@ be determined. \(fn FILE)" nil nil) +(make-obsolete 'image-type-from-file-name 'image-supported-file-p '"29.1") + +(autoload 'image-supported-file-p "image" "\ +Say whether Emacs has native support for displaying TYPE. +The value is a symbol specifying the image type, or nil if type +cannot be determined (or if Emacs doesn't have built-in support +for the image type). + +\(fn FILE)" nil nil) + (autoload 'image-type "image" "\ Determine and return image type. SOURCE is an image file name or image data. @@ -18549,22 +18641,24 @@ Jump to thumbnail buffer." t nil) (autoload 'image-dired-minor-mode "image-dired" "\ Setup easy-to-use keybindings for the commands to be used in Dired mode. + Note that n, p and <down> and <up> will be hijacked and bound to `image-dired-dired-next-line' and `image-dired-dired-previous-line'. This is a minor mode. If called interactively, toggle the -`Image-Dired minor mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +`Image-Dired minor mode' mode. If the prefix argument is +positive, enable the mode, and if it is zero or negative, disable +the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `image-dired-minor-mode'. -The mode's hook is called both when the mode is enabled and when it is -disabled. +The mode's hook is called both when the mode is enabled and when +it is disabled. \(fn &optional ARG)" t nil) @@ -18664,23 +18758,23 @@ or call the function `auto-image-file-mode'.") (autoload 'auto-image-file-mode "image-file" "\ Toggle visiting of image files as images (Auto Image File mode). -This is a minor mode. If called interactively, toggle the +An image file is one whose name has an extension in +`image-file-name-extensions', or matches a regexp in +`image-file-name-regexps'. + +This is a global minor mode. If called interactively, toggle the `Auto-Image-File mode' mode. If the prefix argument is positive, enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='auto-image-file-mode)'. -The mode's hook is called both when the mode is enabled and when it is -disabled. - -An image file is one whose name has an extension in -`image-file-name-extensions', or matches a regexp in -`image-file-name-regexps'. +The mode's hook is called both when the mode is enabled and when +it is disabled. \(fn &optional ARG)" t nil) @@ -18702,23 +18796,23 @@ Key bindings: (autoload 'image-minor-mode "image-mode" "\ Toggle Image minor mode in this buffer. +Image minor mode provides the key \\<image-mode-map>\\[image-toggle-display], +to switch back to `image-mode' and display an image file as the +actual image. + This is a minor mode. If called interactively, toggle the `Image minor mode' mode. If the prefix argument is positive, enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `image-minor-mode'. -The mode's hook is called both when the mode is enabled and when it is -disabled. - -Image minor mode provides the key \\<image-mode-map>\\[image-toggle-display], -to switch back to `image-mode' and display an image file as the -actual image. +The mode's hook is called both when the mode is enabled and when +it is disabled. \(fn &optional ARG)" t nil) @@ -19022,10 +19116,12 @@ Give an empty topic name to go to the Index node itself. \(fn TOPIC)" t nil) (autoload 'info-apropos "info" "\ -Grovel indices of all known Info files on your system for STRING. -Build a menu of the possible matches. +Search indices of all known Info files on your system for STRING. +If REGEXP (interactively, the prefix), use a regexp match. -\(fn STRING)" t nil) +Display a menu of the possible matches. + +\(fn STRING &optional REGEXP)" t nil) (autoload 'info-finder "info" "\ Display descriptions of the keywords in the Finder virtual manual. @@ -19663,20 +19759,6 @@ available on the net." t nil) (autoload 'ispell-minor-mode "ispell" "\ Toggle last-word spell checking (Ispell minor mode). -This is a minor mode. If called interactively, toggle the `ISpell -minor mode' mode. If the prefix argument is positive, enable the -mode, and if it is zero or negative, disable the mode. - -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. - -To check whether the minor mode is enabled in the current buffer, -evaluate `ispell-minor-mode'. - -The mode's hook is called both when the mode is enabled and when it is -disabled. - Ispell minor mode is a buffer-local minor mode. When enabled, typing SPC or RET warns you if the previous word is incorrectly spelled. @@ -19688,6 +19770,20 @@ SPC. For spell-checking \"on the fly\", not just after typing SPC or RET, use `flyspell-mode'. +This is a minor mode. If called interactively, toggle the +`ISpell minor mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. + +To check whether the minor mode is enabled in the current buffer, +evaluate `ispell-minor-mode'. + +The mode's hook is called both when the mode is enabled and when +it is disabled. + \(fn &optional ARG)" t nil) (autoload 'ispell-message "ispell" "\ @@ -19997,11 +20093,9 @@ and the return value is the length of the conversion. (global-set-key "\C-x\C-k" #'kmacro-keymap) (autoload 'kmacro-keymap "kmacro" "Keymap for keyboard macro commands." t 'keymap) -(autoload 'kmacro-exec-ring-item "kmacro" "\ +(define-obsolete-function-alias 'kmacro-exec-ring-item #'funcall "29.1" "\ Execute item ITEM from the macro ring. -ARG is the number of times to execute the item. - -\(fn ITEM ARG)" nil nil) +ARG is the number of times to execute the item.") (autoload 'kmacro-start-macro "kmacro" "\ Record subsequent keyboard input, defining a keyboard macro. @@ -20102,11 +20196,19 @@ If kbd macro currently being defined end it before activating it. \(fn EVENT)" t nil) +(autoload 'kmacro "kmacro" "\ +Create a `kmacro' for macro bound to symbol or key. +KEYS should be a vector or a string that obeys `key-valid-p'. + +\(fn KEYS &optional COUNTER FORMAT)" nil nil) + (autoload 'kmacro-lambda-form "kmacro" "\ -Create lambda form for macro bound to symbol or key. + \(fn MAC &optional COUNTER FORMAT)" nil nil) +(make-obsolete 'kmacro-lambda-form 'kmacro '"29.1") + (register-definition-prefixes "kmacro" '("kdb-macro-redisplay" "kmacro-")) ;;;*** @@ -20361,21 +20463,21 @@ sleep in seconds. (autoload 'linum-mode "linum" "\ Toggle display of line numbers in the left margin (Linum mode). +Linum mode is a buffer-local minor mode. + This is a minor mode. If called interactively, toggle the `Linum -mode' mode. If the prefix argument is positive, enable the mode, and -if it is zero or negative, disable the mode. +mode' mode. If the prefix argument is positive, enable the mode, +and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `linum-mode'. -The mode's hook is called both when the mode is enabled and when it is -disabled. - -Linum mode is a buffer-local minor mode. +The mode's hook is called both when the mode is enabled and when +it is disabled. \(fn &optional ARG)" t nil) @@ -20767,7 +20869,7 @@ and then select the region of un-tablified names and use \(fn TOP BOTTOM &optional MACRO)" t nil) (define-key ctl-x-map "q" 'kbd-macro-query) -(register-definition-prefixes "macros" '("macros--insert-vector-macro")) +(register-definition-prefixes "macros" '("macro")) ;;;*** @@ -20953,24 +21055,24 @@ or call the function `mail-abbrevs-mode'.") (autoload 'mail-abbrevs-mode "mailabbrev" "\ Toggle abbrev expansion of mail aliases (Mail Abbrevs mode). -This is a minor mode. If called interactively, toggle the -`Mail-Abbrevs mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. +Mail Abbrevs mode is a global minor mode. When enabled, +abbrev-like expansion is performed when editing certain mail +headers (those specified by `mail-abbrev-mode-regexp'), based on +the entries in your `mail-personal-alias-file'. + +This is a global minor mode. If called interactively, toggle the +`Mail-Abbrevs mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='mail-abbrevs-mode)'. -The mode's hook is called both when the mode is enabled and when it is -disabled. - -Mail Abbrevs mode is a global minor mode. When enabled, -abbrev-like expansion is performed when editing certain mail -headers (those specified by `mail-abbrev-mode-regexp'), based on -the entries in your `mail-personal-alias-file'. +The mode's hook is called both when the mode is enabled and when +it is disabled. \(fn &optional ARG)" t nil) @@ -21346,20 +21448,6 @@ Populate MENU with commands that open a man page at point. (autoload 'master-mode "master" "\ Toggle Master mode. -This is a minor mode. If called interactively, toggle the `Master -mode' mode. If the prefix argument is positive, enable the mode, and -if it is zero or negative, disable the mode. - -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. - -To check whether the minor mode is enabled in the current buffer, -evaluate `master-mode'. - -The mode's hook is called both when the mode is enabled and when it is -disabled. - When Master mode is enabled, you can scroll the slave buffer using the following commands: @@ -21369,6 +21457,20 @@ The slave buffer is stored in the buffer-local variable `master-of'. You can set this variable using `master-set-slave'. You can show yourself the value of `master-of' by calling `master-show-slave'. +This is a minor mode. If called interactively, toggle the +`Master mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. + +To check whether the minor mode is enabled in the current buffer, +evaluate `master-mode'. + +The mode's hook is called both when the mode is enabled and when +it is disabled. + \(fn &optional ARG)" t nil) (register-definition-prefixes "master" '("master-")) @@ -21391,25 +21493,25 @@ or call the function `minibuffer-depth-indicate-mode'.") (autoload 'minibuffer-depth-indicate-mode "mb-depth" "\ Toggle Minibuffer Depth Indication mode. -This is a minor mode. If called interactively, toggle the +Minibuffer Depth Indication mode is a global minor mode. When +enabled, any recursive use of the minibuffer will show the +recursion depth in the minibuffer prompt. This is only useful if +`enable-recursive-minibuffers' is non-nil. + +This is a global minor mode. If called interactively, toggle the `Minibuffer-Depth-Indicate mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable the -mode. +positive, enable the mode, and if it is zero or negative, disable +the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='minibuffer-depth-indicate-mode)'. -The mode's hook is called both when the mode is enabled and when it is -disabled. - -Minibuffer Depth Indication mode is a global minor mode. When -enabled, any recursive use of the minibuffer will show the -recursion depth in the minibuffer prompt. This is only useful if -`enable-recursive-minibuffers' is non-nil. +The mode's hook is called both when the mode is enabled and when +it is disabled. \(fn &optional ARG)" t nil) @@ -21566,7 +21668,7 @@ Command to parse command line mailto: links. This is meant to be used for MIME handlers: Setting the handler for \"x-scheme-handler/mailto;\" to \"emacs -f message-mailto %u\" will then start up Emacs ready to compose mail. For emacsclient use - emacsclient -e '(message-mailto \"%u\")' + emacsclient -e \\='(message-mailto \"%u\")' \(fn &optional URL)" t nil) @@ -21960,19 +22062,19 @@ or call the function `midnight-mode'.") (autoload 'midnight-mode "midnight" "\ Non-nil means run `midnight-hook' at midnight. -This is a minor mode. If called interactively, toggle the `Midnight -mode' mode. If the prefix argument is positive, enable the mode, and -if it is zero or negative, disable the mode. +This is a global minor mode. If called interactively, toggle the +`Midnight mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='midnight-mode)'. -The mode's hook is called both when the mode is enabled and when it is -disabled. +The mode's hook is called both when the mode is enabled and when +it is disabled. \(fn &optional ARG)" t nil) @@ -22015,21 +22117,6 @@ or call the function `minibuffer-electric-default-mode'.") (autoload 'minibuffer-electric-default-mode "minibuf-eldef" "\ Toggle Minibuffer Electric Default mode. -This is a minor mode. If called interactively, toggle the -`Minibuffer-Electric-Default mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable the -mode. - -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. - -To check whether the minor mode is enabled in the current buffer, -evaluate `(default-value \\='minibuffer-electric-default-mode)'. - -The mode's hook is called both when the mode is enabled and when it is -disabled. - Minibuffer Electric Default mode is a global minor mode. When enabled, minibuffer prompts that show a default value only show the default when it's applicable -- that is, when hitting RET @@ -22037,6 +22124,21 @@ would yield the default value. If the user modifies the input such that hitting RET would enter a non-default value, the prompt is modified to remove the default indication. +This is a global minor mode. If called interactively, toggle the +`Minibuffer-Electric-Default mode' mode. If the prefix argument +is positive, enable the mode, and if it is zero or negative, +disable the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. + +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value \\='minibuffer-electric-default-mode)'. + +The mode's hook is called both when the mode is enabled and when +it is disabled. + \(fn &optional ARG)" t nil) (register-definition-prefixes "minibuf-eldef" '("minibuf")) @@ -22239,7 +22341,7 @@ Major mode for the mixal asm language. ;;;### (autoloads nil "mm-encode" "gnus/mm-encode.el" (0 0 0 0)) ;;; Generated autoloads from gnus/mm-encode.el -(define-obsolete-function-alias 'mm-default-file-encoding #'mm-default-file-type "future") +(define-obsolete-function-alias 'mm-default-file-encoding #'mm-default-file-type "28.1") (autoload 'mm-default-file-type "mm-encode" "\ Return a default content type for FILE. @@ -22602,22 +22704,22 @@ or call the function `msb-mode'.") (autoload 'msb-mode "msb" "\ Toggle Msb mode. -This is a minor mode. If called interactively, toggle the `Msb mode' -mode. If the prefix argument is positive, enable the mode, and if it -is zero or negative, disable the mode. +This mode overrides the binding(s) of `mouse-buffer-menu' to provide a +different buffer menu using the function `msb'. + +This is a global minor mode. If called interactively, toggle the +`Msb mode' mode. If the prefix argument is positive, enable the +mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='msb-mode)'. -The mode's hook is called both when the mode is enabled and when it is -disabled. - -This mode overrides the binding(s) of `mouse-buffer-menu' to provide a -different buffer menu using the function `msb'. +The mode's hook is called both when the mode is enabled and when +it is disabled. \(fn &optional ARG)" t nil) @@ -22954,19 +23056,19 @@ or call the function `mouse-wheel-mode'.") (autoload 'mouse-wheel-mode "mwheel" "\ Toggle mouse wheel support (Mouse Wheel mode). -This is a minor mode. If called interactively, toggle the -`Mouse-Wheel mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. +This is a global minor mode. If called interactively, toggle the +`Mouse-Wheel mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='mouse-wheel-mode)'. -The mode's hook is called both when the mode is enabled and when it is -disabled. +The mode's hook is called both when the mode is enabled and when +it is disabled. \(fn &optional ARG)" t nil) @@ -24587,7 +24689,7 @@ is active. \(fn &optional TODO-ONLY STRING EDIT-AT)" t nil) (autoload 'org-todo-list "org-agenda" "\ -Show all (not done) TODO entries from all agenda file in a single list. +Show all (not done) TODO entries from all agenda files in a single list. The prefix arg can be used to select a specific TODO keyword and limit the list to these. When using `\\[universal-argument]', you will be prompted for a keyword. A numeric prefix directly selects the Nth keyword in @@ -24648,7 +24750,7 @@ Set restriction lock for agenda to current subtree or file. When in a restricted subtree, remove it. The restriction will span over the entire file if TYPE is `file', -or if type is '(4), or if the cursor is before the first headline +or if type is \\='(4), or if the cursor is before the first headline in the file. Otherwise, only apply the restriction to the current subtree. @@ -24901,21 +25003,21 @@ Turning on outline mode calls the value of `text-mode-hook' and then of (autoload 'outline-minor-mode "outline" "\ Toggle Outline minor mode. -This is a minor mode. If called interactively, toggle the `Outline -minor mode' mode. If the prefix argument is positive, enable the -mode, and if it is zero or negative, disable the mode. +See the command `outline-mode' for more information on this mode. + +This is a minor mode. If called interactively, toggle the +`Outline minor mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `outline-minor-mode'. -The mode's hook is called both when the mode is enabled and when it is -disabled. - -See the command `outline-mode' for more information on this mode. +The mode's hook is called both when the mode is enabled and when +it is disabled. \(fn &optional ARG)" t nil) @@ -25466,7 +25568,7 @@ PATTERNS are normal `pcase' patterns, and VALUES are expression. Evaluation happens sequentially as in `setq' (not in parallel). -An example: (pcase-setq `((,a) [(,b)]) '((1) [(2)])) +An example: (pcase-setq \\=`((,a) [(,b)]) \\='((1) [(2)])) VAL is presumed to match PAT. Failure to match may signal an error or go undetected, binding variables to arbitrary values, such as nil. @@ -25960,19 +26062,19 @@ or call the function `pixel-scroll-mode'.") (autoload 'pixel-scroll-mode "pixel-scroll" "\ A minor mode to scroll text pixel-by-pixel. -This is a minor mode. If called interactively, toggle the -`Pixel-Scroll mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. +This is a global minor mode. If called interactively, toggle the +`Pixel-Scroll mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='pixel-scroll-mode)'. -The mode's hook is called both when the mode is enabled and when it is -disabled. +The mode's hook is called both when the mode is enabled and when +it is disabled. \(fn &optional ARG)" t nil) @@ -25988,23 +26090,24 @@ or call the function `pixel-scroll-precision-mode'.") (autoload 'pixel-scroll-precision-mode "pixel-scroll" "\ Toggle pixel scrolling. + When enabled, this minor mode allows to scroll the display precisely, according to the turning of the mouse wheel. -This is a minor mode. If called interactively, toggle the +This is a global minor mode. If called interactively, toggle the `Pixel-Scroll-Precision mode' mode. If the prefix argument is -positive, enable the mode, and if it is zero or negative, disable the -mode. +positive, enable the mode, and if it is zero or negative, disable +the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='pixel-scroll-precision-mode)'. -The mode's hook is called both when the mode is enabled and when it is -disabled. +The mode's hook is called both when the mode is enabled and when +it is disabled. \(fn &optional ARG)" t nil) @@ -26689,8 +26792,12 @@ are both set to t. (autoload 'proced "proced" "\ Generate a listing of UNIX system processes. \\<proced-mode-map> -If invoked with optional ARG, do not select the window displaying -the process information. +If invoked with optional non-negative ARG, do not select the +window displaying the process information. + +If `proced-show-remote-processes' is non-nil or the command is +invoked with a negative ARG `\\[universal-argument] \\[negative-argument]', and `default-directory' +points to a remote host, the system processes of that host are shown. This function runs the normal hook `proced-post-display-hook'. @@ -26931,6 +27038,8 @@ is non-nil, the command will not ask the user for confirmation. NO-CONFIRM is always nil when the command is invoked interactively. +Also see the `project-kill-buffers-display-buffer-list' variable. + \(fn &optional NO-CONFIRM)" t nil) (autoload 'project-remember-project "project" "\ @@ -27814,19 +27923,20 @@ or call the function `rcirc-track-minor-mode'.") (autoload 'rcirc-track-minor-mode "rcirc" "\ Global minor mode for tracking activity in rcirc buffers. -This is a minor mode. If called interactively, toggle the -`Rcirc-Track minor mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +This is a global minor mode. If called interactively, toggle the +`Rcirc-Track minor mode' mode. If the prefix argument is +positive, enable the mode, and if it is zero or negative, disable +the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='rcirc-track-minor-mode)'. -The mode's hook is called both when the mode is enabled and when it is -disabled. +The mode's hook is called both when the mode is enabled and when +it is disabled. \(fn &optional ARG)" t nil) @@ -27874,20 +27984,6 @@ or call the function `recentf-mode'.") (autoload 'recentf-mode "recentf" "\ Toggle \"Open Recent\" menu (Recentf mode). -This is a minor mode. If called interactively, toggle the `Recentf -mode' mode. If the prefix argument is positive, enable the mode, and -if it is zero or negative, disable the mode. - -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. - -To check whether the minor mode is enabled in the current buffer, -evaluate `(default-value \\='recentf-mode)'. - -The mode's hook is called both when the mode is enabled and when it is -disabled. - When Recentf mode is enabled, a \"Open Recent\" submenu is displayed in the \"File\" menu, containing a list of files that were operated on recently, in the most-recently-used order. @@ -27897,7 +27993,21 @@ to a file, and killing a buffer is counted as \"operating\" on the file. If instead you want to prioritize files that appear in buffers you switch to a lot, you can say something like the following: - (add-hook 'buffer-list-update-hook 'recentf-track-opened-file) + (add-hook \\='buffer-list-update-hook #\\='recentf-track-opened-file) + +This is a global minor mode. If called interactively, toggle the +`Recentf mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. + +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value \\='recentf-mode)'. + +The mode's hook is called both when the mode is enabled and when +it is disabled. \(fn &optional ARG)" t nil) @@ -28042,22 +28152,22 @@ with a prefix argument, prompt for START-AT and FORMAT. (autoload 'rectangle-mark-mode "rect" "\ Toggle the region as rectangular. +Activates the region if it's inactive and Transient Mark mode is +on. Only lasts until the region is next deactivated. + This is a minor mode. If called interactively, toggle the `Rectangle-Mark mode' mode. If the prefix argument is positive, enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `rectangle-mark-mode'. -The mode's hook is called both when the mode is enabled and when it is -disabled. - -Activates the region if it's inactive and Transient Mark mode is -on. Only lasts until the region is next deactivated. +The mode's hook is called both when the mode is enabled and when +it is disabled. \(fn &optional ARG)" t nil) @@ -28085,20 +28195,6 @@ on. Only lasts until the region is next deactivated. (autoload 'refill-mode "refill" "\ Toggle automatic refilling (Refill mode). -This is a minor mode. If called interactively, toggle the `Refill -mode' mode. If the prefix argument is positive, enable the mode, and -if it is zero or negative, disable the mode. - -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. - -To check whether the minor mode is enabled in the current buffer, -evaluate `refill-mode'. - -The mode's hook is called both when the mode is enabled and when it is -disabled. - Refill mode is a buffer-local minor mode. When enabled, the current paragraph is refilled as you edit. Self-inserting characters only cause refilling if they would cause @@ -28106,6 +28202,20 @@ auto-filling. For true \"word wrap\" behavior, use `visual-line-mode' instead. +This is a minor mode. If called interactively, toggle the +`Refill mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. + +To check whether the minor mode is enabled in the current buffer, +evaluate `refill-mode'. + +The mode's hook is called both when the mode is enabled and when +it is disabled. + \(fn &optional ARG)" t nil) (register-definition-prefixes "refill" '("refill-")) @@ -28125,20 +28235,6 @@ Turn on RefTeX mode." nil nil) (autoload 'reftex-mode "reftex" "\ Minor mode with distinct support for \\label, \\ref and \\cite in LaTeX. -This is a minor mode. If called interactively, toggle the `Reftex -mode' mode. If the prefix argument is positive, enable the mode, and -if it is zero or negative, disable the mode. - -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. - -To check whether the minor mode is enabled in the current buffer, -evaluate `reftex-mode'. - -The mode's hook is called both when the mode is enabled and when it is -disabled. - \\<reftex-mode-map>A Table of Contents of the entire (multifile) document with browsing capabilities is available with `\\[reftex-toc]'. @@ -28167,6 +28263,20 @@ on the menu bar. ------------------------------------------------------------------------------ +This is a minor mode. If called interactively, toggle the +`Reftex mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. + +To check whether the minor mode is enabled in the current buffer, +evaluate `reftex-mode'. + +The mode's hook is called both when the mode is enabled and when +it is disabled. + \(fn &optional ARG)" t nil) (autoload 'reftex-reset-scanning-information "reftex" "\ @@ -28355,23 +28465,24 @@ or call the function `repeat-mode'.") (autoload 'repeat-mode "repeat" "\ Toggle Repeat mode. + When Repeat mode is enabled, and the command symbol has the property named `repeat-map', this map is activated temporarily for the next command. See `describe-repeat-maps' for a list of all repeatable commands. -This is a minor mode. If called interactively, toggle the `Repeat -mode' mode. If the prefix argument is positive, enable the mode, and -if it is zero or negative, disable the mode. +This is a global minor mode. If called interactively, toggle the +`Repeat mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='repeat-mode)'. -The mode's hook is called both when the mode is enabled and when it is -disabled. +The mode's hook is called both when the mode is enabled and when +it is disabled. \(fn &optional ARG)" t nil) @@ -28448,24 +28559,24 @@ report errors as appropriate for this kind of usage. (autoload 'reveal-mode "reveal" "\ Toggle uncloaking of invisible text near point (Reveal mode). -This is a minor mode. If called interactively, toggle the `Reveal -mode' mode. If the prefix argument is positive, enable the mode, and -if it is zero or negative, disable the mode. +Reveal mode is a buffer-local minor mode. When enabled, it +reveals invisible text around point. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. +Also see the `reveal-auto-hide' variable. -To check whether the minor mode is enabled in the current buffer, -evaluate `reveal-mode'. +This is a minor mode. If called interactively, toggle the +`Reveal mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. -The mode's hook is called both when the mode is enabled and when it is -disabled. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. -Reveal mode is a buffer-local minor mode. When enabled, it -reveals invisible text around point. +To check whether the minor mode is enabled in the current buffer, +evaluate `reveal-mode'. -Also see the `reveal-auto-hide' variable. +The mode's hook is called both when the mode is enabled and when +it is disabled. \(fn &optional ARG)" t nil) @@ -28481,21 +28592,22 @@ or call the function `global-reveal-mode'.") (autoload 'global-reveal-mode "reveal" "\ Toggle Reveal mode in all buffers (Global Reveal mode). + Reveal mode renders invisible text around point visible again. -This is a minor mode. If called interactively, toggle the `Global -Reveal mode' mode. If the prefix argument is positive, enable the -mode, and if it is zero or negative, disable the mode. +This is a global minor mode. If called interactively, toggle the +`Global Reveal mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='global-reveal-mode)'. -The mode's hook is called both when the mode is enabled and when it is -disabled. +The mode's hook is called both when the mode is enabled and when +it is disabled. \(fn &optional ARG)" t nil) @@ -29236,20 +29348,6 @@ Validation will be enabled if `rng-nxml-auto-validate-flag' is non-nil." t nil) (autoload 'rng-validate-mode "rng-valid" "\ Minor mode performing continual validation against a RELAX NG schema. -This is a minor mode. If called interactively, toggle the -`Rng-Validate mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. - -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. - -To check whether the minor mode is enabled in the current buffer, -evaluate `rng-validate-mode'. - -The mode's hook is called both when the mode is enabled and when it is -disabled. - Checks whether the buffer is a well-formed XML 1.0 document, conforming to the XML Namespaces Recommendation and valid against a RELAX NG schema. The mode-line indicates whether it is or not. Any @@ -29270,6 +29368,20 @@ conventionally have a suffix of `.rnc'). The variable `rng-schema-locating-files' specifies files containing rules to use for finding the schema. +This is a minor mode. If called interactively, toggle the +`Rng-Validate mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. + +To check whether the minor mode is enabled in the current buffer, +evaluate `rng-validate-mode'. + +The mode's hook is called both when the mode is enabled and when +it is disabled. + \(fn &optional ARG)" t nil) (register-definition-prefixes "rng-valid" '("rng-")) @@ -29396,23 +29508,23 @@ highlighting. (autoload 'rst-minor-mode "rst" "\ Toggle ReST minor mode. -This is a minor mode. If called interactively, toggle the `Rst minor -mode' mode. If the prefix argument is positive, enable the mode, and -if it is zero or negative, disable the mode. +When ReST minor mode is enabled, the ReST mode keybindings +are installed on top of the major mode bindings. Use this +for modes derived from Text mode, like Mail mode. + +This is a minor mode. If called interactively, toggle the `Rst +minor mode' mode. If the prefix argument is positive, enable the +mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `rst-minor-mode'. -The mode's hook is called both when the mode is enabled and when it is -disabled. - -When ReST minor mode is enabled, the ReST mode keybindings -are installed on top of the major mode bindings. Use this -for modes derived from Text mode, like Mail mode. +The mode's hook is called both when the mode is enabled and when +it is disabled. \(fn &optional ARG)" t nil) @@ -29456,18 +29568,18 @@ Use the command `ruler-mode' to change this variable.") Toggle display of ruler in header line (Ruler mode). This is a minor mode. If called interactively, toggle the `Ruler -mode' mode. If the prefix argument is positive, enable the mode, and -if it is zero or negative, disable the mode. +mode' mode. If the prefix argument is positive, enable the mode, +and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `ruler-mode'. -The mode's hook is called both when the mode is enabled and when it is -disabled. +The mode's hook is called both when the mode is enabled and when +it is disabled. \(fn &optional ARG)" t nil) @@ -29736,20 +29848,6 @@ or call the function `savehist-mode'.") (autoload 'savehist-mode "savehist" "\ Toggle saving of minibuffer history (Savehist mode). -This is a minor mode. If called interactively, toggle the `Savehist -mode' mode. If the prefix argument is positive, enable the mode, and -if it is zero or negative, disable the mode. - -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. - -To check whether the minor mode is enabled in the current buffer, -evaluate `(default-value \\='savehist-mode)'. - -The mode's hook is called both when the mode is enabled and when it is -disabled. - When Savehist mode is enabled, minibuffer history is saved to `savehist-file' periodically and when exiting Emacs. When Savehist mode is enabled for the first time in an Emacs session, @@ -29776,6 +29874,20 @@ This mode should normally be turned on from your Emacs init file. Calling it at any other time replaces your current minibuffer histories, which is probably undesirable. +This is a global minor mode. If called interactively, toggle the +`Savehist mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. + +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value \\='savehist-mode)'. + +The mode's hook is called both when the mode is enabled and when +it is disabled. + \(fn &optional ARG)" t nil) (register-definition-prefixes "savehist" '("savehist-")) @@ -29797,49 +29909,52 @@ or call the function `save-place-mode'.") (autoload 'save-place-mode "saveplace" "\ Non-nil means automatically save place in each file. + This means when you visit a file, point goes to the last place where it was when you previously visited the same file. -This is a minor mode. If called interactively, toggle the `Save-Place -mode' mode. If the prefix argument is positive, enable the mode, and -if it is zero or negative, disable the mode. +This is a global minor mode. If called interactively, toggle the +`Save-Place mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='save-place-mode)'. -The mode's hook is called both when the mode is enabled and when it is -disabled. +The mode's hook is called both when the mode is enabled and when +it is disabled. \(fn &optional ARG)" t nil) (autoload 'save-place-local-mode "saveplace" "\ Toggle whether to save your place in this file between sessions. + If this mode is enabled, point is recorded when you kill the buffer or exit Emacs. Visiting this file again will go to that position, even in a later Emacs session. +To save places automatically in all files, put this in your init +file: + +\(save-place-mode 1) + This is a minor mode. If called interactively, toggle the -`Save-Place-Local mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +`Save-Place-Local mode' mode. If the prefix argument is +positive, enable the mode, and if it is zero or negative, disable +the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `save-place-mode'. -The mode's hook is called both when the mode is enabled and when it is -disabled. - -To save places automatically in all files, put this in your init -file: - -\(save-place-mode 1) +The mode's hook is called both when the mode is enabled and when +it is disabled. \(fn &optional ARG)" t nil) @@ -29919,22 +30034,22 @@ or call the function `scroll-all-mode'.") (autoload 'scroll-all-mode "scroll-all" "\ Toggle shared scrolling in same-frame windows (Scroll-All mode). -This is a minor mode. If called interactively, toggle the `Scroll-All -mode' mode. If the prefix argument is positive, enable the mode, and -if it is zero or negative, disable the mode. +When Scroll-All mode is enabled, scrolling commands invoked in +one window apply to all visible windows in the same frame. + +This is a global minor mode. If called interactively, toggle the +`Scroll-All mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='scroll-all-mode)'. -The mode's hook is called both when the mode is enabled and when it is -disabled. - -When Scroll-All mode is enabled, scrolling commands invoked in -one window apply to all visible windows in the same frame. +The mode's hook is called both when the mode is enabled and when +it is disabled. \(fn &optional ARG)" t nil) @@ -29955,20 +30070,6 @@ one window apply to all visible windows in the same frame. (autoload 'scroll-lock-mode "scroll-lock" "\ Buffer-local minor mode for pager-like scrolling. -This is a minor mode. If called interactively, toggle the -`Scroll-Lock mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. - -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. - -To check whether the minor mode is enabled in the current buffer, -evaluate `scroll-lock-mode'. - -The mode's hook is called both when the mode is enabled and when it is -disabled. - When enabled, keys that normally move point by line or paragraph will scroll the buffer by the respective amount of lines instead and point will be kept vertically fixed relative to window @@ -29977,6 +30078,20 @@ boundaries during scrolling. Note that the default key binding to `scroll' will not work on MS-Windows systems if `w32-scroll-lock-modifier' is non-nil. +This is a minor mode. If called interactively, toggle the +`Scroll-Lock mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. + +To check whether the minor mode is enabled in the current buffer, +evaluate `scroll-lock-mode'. + +The mode's hook is called both when the mode is enabled and when +it is disabled. + \(fn &optional ARG)" t nil) (register-definition-prefixes "scroll-lock" '("scroll-lock-")) @@ -30034,20 +30149,6 @@ or call the function `semantic-mode'.") (autoload 'semantic-mode "semantic" "\ Toggle parser features (Semantic mode). -This is a minor mode. If called interactively, toggle the `Semantic -mode' mode. If the prefix argument is positive, enable the mode, and -if it is zero or negative, disable the mode. - -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. - -To check whether the minor mode is enabled in the current buffer, -evaluate `(default-value \\='semantic-mode)'. - -The mode's hook is called both when the mode is enabled and when it is -disabled. - In Semantic mode, Emacs parses the buffers you visit for their semantic content. This information is used by a variety of auxiliary minor modes, listed in `semantic-default-submodes'; @@ -30056,6 +30157,20 @@ Semantic mode. \\{semantic-mode-map} +This is a global minor mode. If called interactively, toggle the +`Semantic mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. + +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value \\='semantic-mode)'. + +The mode's hook is called both when the mode is enabled and when +it is disabled. + \(fn &optional ARG)" t nil) (register-definition-prefixes "semantic" '("bovinate" "semantic-")) @@ -30712,23 +30827,23 @@ or call the function `server-mode'.") (autoload 'server-mode "server" "\ Toggle Server mode. -This is a minor mode. If called interactively, toggle the `Server -mode' mode. If the prefix argument is positive, enable the mode, and -if it is zero or negative, disable the mode. +Server mode runs a process that accepts commands from the +`emacsclient' program. See Info node `Emacs server' and +`server-start' for details. + +This is a global minor mode. If called interactively, toggle the +`Server mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='server-mode)'. -The mode's hook is called both when the mode is enabled and when it is -disabled. - -Server mode runs a process that accepts commands from the -`emacsclient' program. See Info node `Emacs server' and -`server-start' for details. +The mode's hook is called both when the mode is enabled and when +it is disabled. \(fn &optional ARG)" t nil) @@ -31381,21 +31496,21 @@ buffer names. (autoload 'smerge-mode "smerge-mode" "\ Minor mode to simplify editing output from the diff3 program. -This is a minor mode. If called interactively, toggle the `SMerge -mode' mode. If the prefix argument is positive, enable the mode, and -if it is zero or negative, disable the mode. +\\{smerge-mode-map} -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. +This is a minor mode. If called interactively, toggle the +`SMerge mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `smerge-mode'. -The mode's hook is called both when the mode is enabled and when it is -disabled. - -\\{smerge-mode-map} +The mode's hook is called both when the mode is enabled and when +it is disabled. \(fn &optional ARG)" t nil) @@ -31517,26 +31632,26 @@ Open the customization group `so-long'." t nil) (autoload 'so-long-minor-mode "so-long" "\ This is the minor mode equivalent of `so-long-mode'. -This is a minor mode. If called interactively, toggle the `So-Long -minor mode' mode. If the prefix argument is positive, enable the -mode, and if it is zero or negative, disable the mode. - -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. - -To check whether the minor mode is enabled in the current buffer, -evaluate `so-long-minor-mode'. - -The mode's hook is called both when the mode is enabled and when it is -disabled. - Any active minor modes listed in `so-long-minor-modes' are disabled for the current buffer, and buffer-local values are assigned to variables in accordance with `so-long-variable-overrides'. This minor mode is a standard `so-long-action' option. +This is a minor mode. If called interactively, toggle the +`So-Long minor mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. + +To check whether the minor mode is enabled in the current buffer, +evaluate `so-long-minor-mode'. + +The mode's hook is called both when the mode is enabled and when +it is disabled. + \(fn &optional ARG)" t nil) (autoload 'so-long-mode "so-long" "\ @@ -31603,20 +31718,6 @@ or call the function `global-so-long-mode'.") (autoload 'global-so-long-mode "so-long" "\ Toggle automated performance mitigations for files with long lines. -This is a minor mode. If called interactively, toggle the `Global -So-Long mode' mode. If the prefix argument is positive, enable the -mode, and if it is zero or negative, disable the mode. - -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. - -To check whether the minor mode is enabled in the current buffer, -evaluate `(default-value \\='global-so-long-mode)'. - -The mode's hook is called both when the mode is enabled and when it is -disabled. - Many Emacs modes struggle with buffers which contain excessively long lines, and may consequently cause unacceptable performance issues. @@ -31632,6 +31733,20 @@ Use \\[so-long-commentary] for more information. Use \\[so-long-customize] to open the customization group `so-long' to configure the behaviour. +This is a global minor mode. If called interactively, toggle the +`Global So-Long mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. + +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value \\='global-so-long-mode)'. + +The mode's hook is called both when the mode is enabled and when +it is disabled. + \(fn &optional ARG)" t nil) (register-definition-prefixes "so-long" '("so-long-" "turn-o")) @@ -32666,6 +32781,38 @@ Major-mode for writing SRecode macros. ;;;*** +;;;### (autoloads nil "string-edit" "textmodes/string-edit.el" (0 +;;;;;; 0 0 0)) +;;; Generated autoloads from textmodes/string-edit.el + +(autoload 'string-edit "string-edit" "\ +Switch to a new buffer to edit STRING. +When the user finishes editing (with \\<string-edit-mode-map>\\[string-edit-done]), SUCCESS-CALLBACK +is called with the resulting string. + +If the user aborts (with \\<string-edit-mode-map>\\[string-edit-abort]), ABORT-CALLBACK (if any) is +called with no parameters. + +PROMPT will be inserted at the start of the buffer, but won't be +included in the resulting string. If PROMPT is nil, no help text +will be inserted. + +\(fn PROMPT STRING SUCCESS-CALLBACK &key ABORT-CALLBACK)" nil nil) + +(autoload 'read-string-from-buffer "string-edit" "\ +Switch to a new buffer to edit STRING in a recursive edit. +The user finishes editing with \\<string-edit-mode-map>\\[string-edit-done], or aborts with \\<string-edit-mode-map>\\[string-edit-abort]). + +PROMPT will be inserted at the start of the buffer, but won't be +included in the resulting string. If nil, no prompt will be +inserted in the buffer. + +\(fn PROMPT STRING)" nil nil) + +(register-definition-prefixes "string-edit" '("string-edit-")) + +;;;*** + ;;;### (autoloads nil "strokes" "strokes.el" (0 0 0 0)) ;;; Generated autoloads from strokes.el @@ -32744,20 +32891,6 @@ or call the function `strokes-mode'.") (autoload 'strokes-mode "strokes" "\ Toggle Strokes mode, a global minor mode. -This is a minor mode. If called interactively, toggle the `Strokes -mode' mode. If the prefix argument is positive, enable the mode, and -if it is zero or negative, disable the mode. - -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. - -To check whether the minor mode is enabled in the current buffer, -evaluate `(default-value \\='strokes-mode)'. - -The mode's hook is called both when the mode is enabled and when it is -disabled. - \\<strokes-mode-map> Strokes are pictographic mouse gestures which invoke commands. Strokes are invoked with \\[strokes-do-stroke]. You can define @@ -32771,6 +32904,20 @@ Encode/decode your strokes with \\[strokes-encode-buffer], \\{strokes-mode-map} +This is a global minor mode. If called interactively, toggle the +`Strokes mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. + +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value \\='strokes-mode)'. + +The mode's hook is called both when the mode is enabled and when +it is disabled. + \(fn &optional ARG)" t nil) (autoload 'strokes-decode-buffer "strokes" "\ @@ -32853,27 +33000,6 @@ removed. \(fn STRING)" nil nil) -(autoload 'string-lines "subr-x" "\ -Split STRING into a list of lines. -If OMIT-NULLS, empty lines will be removed from the results. - -\(fn STRING &optional OMIT-NULLS)" nil nil) - -(autoload 'ensure-empty-lines "subr-x" "\ -Ensure that there are LINES number of empty lines before point. -If LINES is nil or omitted, ensure that there is a single empty -line before point. - -If called interactively, LINES is given by the prefix argument. - -If there are more than LINES empty lines before point, the number -of empty lines is reduced to LINES. - -If point is not at the beginning of a line, a newline character -is inserted before adjusting the number of empty lines. - -\(fn &optional LINES)" t nil) - (autoload 'string-pixel-width "subr-x" "\ Return the width of STRING in pixels. @@ -32912,20 +33038,6 @@ Query the user for a process and return the process object. (autoload 'subword-mode "subword" "\ Toggle subword movement and editing (Subword mode). -This is a minor mode. If called interactively, toggle the `Subword -mode' mode. If the prefix argument is positive, enable the mode, and -if it is zero or negative, disable the mode. - -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. - -To check whether the minor mode is enabled in the current buffer, -evaluate `subword-mode'. - -The mode's hook is called both when the mode is enabled and when it is -disabled. - Subword mode is a buffer-local minor mode. Enabling it changes the definition of a word so that word-based commands stop inside symbols with mixed uppercase and lowercase letters, @@ -32944,6 +33056,20 @@ called a `subword'. Here are some examples: This mode changes the definition of a word so that word commands treat nomenclature boundaries as word boundaries. +This is a minor mode. If called interactively, toggle the +`Subword mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. + +To check whether the minor mode is enabled in the current buffer, +evaluate `subword-mode'. + +The mode's hook is called both when the mode is enabled and when +it is disabled. + \(fn &optional ARG)" t nil) (put 'global-subword-mode 'globalized-minor-mode t) @@ -32977,20 +33103,6 @@ See `subword-mode' for more information on Subword mode. (autoload 'superword-mode "subword" "\ Toggle superword movement and editing (Superword mode). -This is a minor mode. If called interactively, toggle the `Superword -mode' mode. If the prefix argument is positive, enable the mode, and -if it is zero or negative, disable the mode. - -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. - -To check whether the minor mode is enabled in the current buffer, -evaluate `superword-mode'. - -The mode's hook is called both when the mode is enabled and when it is -disabled. - Superword mode is a buffer-local minor mode. Enabling it changes the definition of words such that characters which have symbol syntax are treated as parts of words: e.g., in `superword-mode', @@ -32998,6 +33110,20 @@ syntax are treated as parts of words: e.g., in `superword-mode', \\{superword-mode-map} +This is a minor mode. If called interactively, toggle the +`Superword mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. + +To check whether the minor mode is enabled in the current buffer, +evaluate `superword-mode'. + +The mode's hook is called both when the mode is enabled and when +it is disabled. + \(fn &optional ARG)" t nil) (put 'global-superword-mode 'globalized-minor-mode t) @@ -33088,20 +33214,6 @@ or call the function `gpm-mouse-mode'.") (autoload 'gpm-mouse-mode "t-mouse" "\ Toggle mouse support in GNU/Linux consoles (GPM Mouse mode). -This is a minor mode. If called interactively, toggle the `Gpm-Mouse -mode' mode. If the prefix argument is positive, enable the mode, and -if it is zero or negative, disable the mode. - -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. - -To check whether the minor mode is enabled in the current buffer, -evaluate `(default-value \\='gpm-mouse-mode)'. - -The mode's hook is called both when the mode is enabled and when it is -disabled. - This allows the use of the mouse when operating on a GNU/Linux console, in the same way as you can use the mouse under X11. It relies on the `gpm' daemon being activated. @@ -33110,6 +33222,20 @@ Note that when `gpm-mouse-mode' is enabled, you cannot use the mouse to transfer text between Emacs and other programs which use GPM. This is due to limitations in GPM and the Linux kernel. +This is a global minor mode. If called interactively, toggle the +`Gpm-Mouse mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. + +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value \\='gpm-mouse-mode)'. + +The mode's hook is called both when the mode is enabled and when +it is disabled. + \(fn &optional ARG)" t nil) (register-definition-prefixes "t-mouse" '("gpm-mouse-")) @@ -33122,19 +33248,19 @@ GPM. This is due to limitations in GPM and the Linux kernel. (autoload 'tab-line-mode "tab-line" "\ Toggle display of tab line in the windows displaying the current buffer. -This is a minor mode. If called interactively, toggle the `Tab-Line -mode' mode. If the prefix argument is positive, enable the mode, and -if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the +`Tab-Line mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `tab-line-mode'. -The mode's hook is called both when the mode is enabled and when it is -disabled. +The mode's hook is called both when the mode is enabled and when +it is disabled. \(fn &optional ARG)" t nil) @@ -33208,6 +33334,7 @@ The variable `tab-width' controls the spacing of tab stops. (autoload 'table-fixed-width-mode "table" "\ Cell width is fixed when this is non-nil. + Normally it should be nil for allowing automatic cell width expansion that widens a cell when it is necessary. When non-nil, typing in a cell does not automatically expand the cell width. A word that is too @@ -33217,18 +33344,19 @@ variable's value can be toggled by \\[table-fixed-width-mode] at run-time. This is a minor mode. If called interactively, toggle the -`Table-Fixed-Width mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. +`Table-Fixed-Width mode' mode. If the prefix argument is +positive, enable the mode, and if it is zero or negative, disable +the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `table-fixed-width-mode'. -The mode's hook is called both when the mode is enabled and when it is -disabled. +The mode's hook is called both when the mode is enabled and when +it is disabled. \(fn &optional ARG)" t nil) @@ -34535,7 +34663,7 @@ Compose Thai characters in the current buffer." t nil) (autoload 'forward-thing "thingatpt" "\ Move forward to the end of the Nth next THING. THING should be a symbol specifying a type of syntactic entity. -Possibilities include `symbol', `list', `sexp', `defun', +Possibilities include `symbol', `list', `sexp', `defun', `number', `filename', `url', `email', `uuid', `word', `sentence', `whitespace', `line', and `page'. @@ -34544,7 +34672,7 @@ Possibilities include `symbol', `list', `sexp', `defun', (autoload 'bounds-of-thing-at-point "thingatpt" "\ Determine the start and end buffer locations for the THING at point. THING should be a symbol specifying a type of syntactic entity. -Possibilities include `symbol', `list', `sexp', `defun', +Possibilities include `symbol', `list', `sexp', `defun', `number', `filename', `url', `email', `uuid', `word', `sentence', `whitespace', `line', and `page'. @@ -34788,20 +34916,6 @@ This function is meant to be used as a `post-self-insert-hook'." t nil) (autoload 'tildify-mode "tildify" "\ Adds electric behavior to space character. -This is a minor mode. If called interactively, toggle the `Tildify -mode' mode. If the prefix argument is positive, enable the mode, and -if it is zero or negative, disable the mode. - -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. - -To check whether the minor mode is enabled in the current buffer, -evaluate `tildify-mode'. - -The mode's hook is called both when the mode is enabled and when it is -disabled. - When space is inserted into a buffer in a position where hard space is required instead (determined by `tildify-space-pattern' and `tildify-space-predicates'), that space character is replaced by a hard space specified by @@ -34811,6 +34925,20 @@ When `tildify-mode' is enabled, if `tildify-string-alist' specifies a hard space representation for current major mode, the `tildify-space-string' buffer-local variable will be set to the representation. +This is a minor mode. If called interactively, toggle the +`Tildify mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. + +To check whether the minor mode is enabled in the current buffer, +evaluate `tildify-mode'. + +The mode's hook is called both when the mode is enabled and when +it is disabled. + \(fn &optional ARG)" t nil) (register-definition-prefixes "tildify" '("tildify-")) @@ -34846,26 +34974,26 @@ or call the function `display-time-mode'.") (autoload 'display-time-mode "time" "\ Toggle display of time, load level, and mail flag in mode lines. -This is a minor mode. If called interactively, toggle the -`Display-Time mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. - -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. - -To check whether the minor mode is enabled in the current buffer, -evaluate `(default-value \\='display-time-mode)'. - -The mode's hook is called both when the mode is enabled and when it is -disabled. - When Display Time mode is enabled, it updates every minute (you can control the number of seconds between updates by customizing `display-time-interval'). If `display-time-day-and-date' is non-nil, the current day and date are displayed as well. This runs the normal hook `display-time-hook' after each update. +This is a global minor mode. If called interactively, toggle the +`Display-Time mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. + +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value \\='display-time-mode)'. + +The mode's hook is called both when the mode is enabled and when +it is disabled. + \(fn &optional ARG)" t nil) (define-obsolete-function-alias 'display-time-world #'world-clock "28.1") @@ -34985,6 +35113,10 @@ The \"%z\" specifier does not print anything. When it is used, specifiers must be given in order of decreasing size. To the left of \"%z\", nothing is output until the first non-zero unit is encountered. +The \"%x\" specifier does not print anything. When it is used, +specifiers must be given in order of decreasing size. To the +right of \"%x\", trailing zero units are not output. + \(fn STRING SECONDS)" nil nil) (autoload 'seconds-to-string "time-date" "\ @@ -35505,7 +35637,7 @@ like \"/sys\" or \"/C:\".") Load Tramp file name handler, and perform OPERATION." (tramp-unload-file-name-handlers) (when tramp-mode (let ((default-directory temporary-file-directory)) (when (bound-and-true-p tramp-archive-autoload) (load "tramp-archive" 'noerror 'nomessage)) (load "tramp" 'noerror 'nomessage))) (apply operation args)) (defun tramp-register-autoload-file-name-handlers nil "\ -Add Tramp file name handlers to `file-name-handler-alist' during autoload." (add-to-list 'file-name-handler-alist (cons tramp-autoload-file-name-regexp #'tramp-autoload-file-name-handler)) (put #'tramp-autoload-file-name-handler 'safe-magic t)) +Add Tramp file name handlers to `file-name-handler-alist' during autoload." (unless (rassq #'tramp-file-name-handler file-name-handler-alist) (add-to-list 'file-name-handler-alist (cons tramp-autoload-file-name-regexp #'tramp-autoload-file-name-handler)) (put #'tramp-autoload-file-name-handler 'safe-magic t))) (tramp-register-autoload-file-name-handlers) (defun tramp-unload-file-name-handlers nil "\ @@ -35544,10 +35676,10 @@ It must be supported by libarchive(3).") Regular expression matching archive file names." '(concat "\\`" "\\(" ".+" "\\." (regexp-opt tramp-archive-suffixes) "\\(?:" "\\." (regexp-opt tramp-archive-compression-suffixes) "\\)*" "\\)" "\\(" "/" ".*" "\\)" "\\'")) (defun tramp-archive-autoload-file-name-handler (operation &rest args) "\ -Load Tramp archive file name handler, and perform OPERATION." (defvar tramp-archive-autoload) (when tramp-archive-enabled (let ((default-directory temporary-file-directory) (tramp-archive-autoload t)) (apply #'tramp-autoload-file-name-handler operation args)))) +Load Tramp archive file name handler, and perform OPERATION." (defvar tramp-archive-autoload) (let ((default-directory temporary-file-directory) (tramp-archive-autoload tramp-archive-enabled)) (apply #'tramp-autoload-file-name-handler operation args))) (defun tramp-register-archive-file-name-handler nil "\ -Add archive file name handler to `file-name-handler-alist'." (when tramp-archive-enabled (add-to-list 'file-name-handler-alist (cons (tramp-archive-autoload-file-name-regexp) #'tramp-archive-autoload-file-name-handler)) (put #'tramp-archive-autoload-file-name-handler 'safe-magic t))) +Add archive file name handler to `file-name-handler-alist'." (when (and tramp-archive-enabled (not (rassq #'tramp-archive-file-name-handler file-name-handler-alist))) (add-to-list 'file-name-handler-alist (cons (tramp-archive-autoload-file-name-regexp) #'tramp-archive-autoload-file-name-handler)) (put #'tramp-archive-autoload-file-name-handler 'safe-magic t))) (add-hook 'after-init-hook #'tramp-register-archive-file-name-handler) @@ -35838,21 +35970,8 @@ or call the function `type-break-mode'.") (autoload 'type-break-mode "type-break" "\ Enable or disable typing-break mode. -This is a minor mode, but it is global to all buffers by default. - -This is a minor mode. If called interactively, toggle the `Type-Break -mode' mode. If the prefix argument is positive, enable the mode, and -if it is zero or negative, disable the mode. - -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. - -To check whether the minor mode is enabled in the current buffer, -evaluate `(default-value \\='type-break-mode)'. -The mode's hook is called both when the mode is enabled and when it is -disabled. +This is a minor mode, but it is global to all buffers by default. When this mode is enabled, the user is encouraged to take typing breaks at appropriate intervals; either after a specified amount of time or when the @@ -35921,6 +36040,20 @@ across Emacs sessions. This provides recovery of the break status between sessions and after a crash. Manual changes to the file may result in problems. +This is a global minor mode. If called interactively, toggle the +`Type-Break mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. + +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value \\='type-break-mode)'. + +The mode's hook is called both when the mode is enabled and when +it is disabled. + \(fn &optional ARG)" t nil) (autoload 'type-break "type-break" "\ @@ -36332,29 +36465,30 @@ or call the function `url-handler-mode'.") (autoload 'url-handler-mode "url-handlers" "\ Handle URLs as if they were file names throughout Emacs. + After switching on this minor mode, Emacs file primitives handle URLs. For instance: -This is a minor mode. If called interactively, toggle the -`Url-Handler mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. - -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. - -To check whether the minor mode is enabled in the current buffer, -evaluate `(default-value \\='url-handler-mode)'. - -The mode's hook is called both when the mode is enabled and when it is -disabled. - (file-exists-p \"https://www.gnu.org/\") => t and `C-x C-f https://www.gnu.org/ RET' will give you the HTML at that URL in a buffer. +This is a global minor mode. If called interactively, toggle the +`Url-Handler mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. + +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value \\='url-handler-mode)'. + +The mode's hook is called both when the mode is enabled and when +it is disabled. + \(fn &optional ARG)" t nil) (autoload 'url-file-handler "url-handlers" "\ @@ -38531,20 +38665,6 @@ own View-like bindings. (autoload 'view-mode "view" "\ Toggle View mode, a minor mode for viewing text but not editing it. -This is a minor mode. If called interactively, toggle the `View mode' -mode. If the prefix argument is positive, enable the mode, and if it -is zero or negative, disable the mode. - -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. - -To check whether the minor mode is enabled in the current buffer, -evaluate `view-mode'. - -The mode's hook is called both when the mode is enabled and when it is -disabled. - When View mode is enabled, commands that do not change the buffer contents are available as usual. Kill commands save text but do not delete it from the buffer. Most other commands beep and @@ -38622,6 +38742,20 @@ then \\[View-leave], \\[View-quit] and \\[View-kill-and-leave] will return to th Entry to view-mode runs the normal hook `view-mode-hook'. +This is a minor mode. If called interactively, toggle the `View +mode' mode. If the prefix argument is positive, enable the mode, +and if it is zero or negative, disable the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. + +To check whether the minor mode is enabled in the current buffer, +evaluate `view-mode'. + +The mode's hook is called both when the mode is enabled and when +it is disabled. + \(fn &optional ARG)" t nil) (autoload 'view-return-to-alist-update "view" "\ @@ -38906,23 +39040,23 @@ or call the function `which-function-mode'.") (autoload 'which-function-mode "which-func" "\ Toggle mode line display of current function (Which Function mode). -This is a minor mode. If called interactively, toggle the +Which Function mode is a global minor mode. When enabled, the +current function name is continuously displayed in the mode line, +in certain major modes. + +This is a global minor mode. If called interactively, toggle the `Which-Function mode' mode. If the prefix argument is positive, enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='which-function-mode)'. -The mode's hook is called both when the mode is enabled and when it is -disabled. - -Which Function mode is a global minor mode. When enabled, the -current function name is continuously displayed in the mode line, -in certain major modes. +The mode's hook is called both when the mode is enabled and when +it is disabled. \(fn &optional ARG)" t nil) @@ -38937,44 +39071,30 @@ in certain major modes. (autoload 'whitespace-mode "whitespace" "\ Toggle whitespace visualization (Whitespace mode). -This is a minor mode. If called interactively, toggle the `Whitespace -mode' mode. If the prefix argument is positive, enable the mode, and -if it is zero or negative, disable the mode. - -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. - -To check whether the minor mode is enabled in the current buffer, -evaluate `whitespace-mode'. - -The mode's hook is called both when the mode is enabled and when it is -disabled. - See also `whitespace-style', `whitespace-newline' and `whitespace-display-mappings'. This mode uses a number of faces to visualize the whitespace; see the customization group `whitespace' for details. -\(fn &optional ARG)" t nil) - -(autoload 'whitespace-newline-mode "whitespace" "\ -Toggle newline visualization (Whitespace Newline mode). - This is a minor mode. If called interactively, toggle the -`Whitespace-Newline mode' mode. If the prefix argument is positive, +`Whitespace mode' mode. If the prefix argument is positive, enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, -evaluate `whitespace-newline-mode'. +evaluate `whitespace-mode'. -The mode's hook is called both when the mode is enabled and when it is -disabled. +The mode's hook is called both when the mode is enabled and when +it is disabled. + +\(fn &optional ARG)" t nil) + +(autoload 'whitespace-newline-mode "whitespace" "\ +Toggle newline visualization (Whitespace Newline mode). Use `whitespace-newline-mode' only for NEWLINE visualization exclusively. For other visualizations, including NEWLINE @@ -38983,6 +39103,21 @@ use `whitespace-mode'. See also `whitespace-newline' and `whitespace-display-mappings'. +This is a minor mode. If called interactively, toggle the +`Whitespace-Newline mode' mode. If the prefix argument is +positive, enable the mode, and if it is zero or negative, disable +the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. + +To check whether the minor mode is enabled in the current buffer, +evaluate `whitespace-newline-mode'. + +The mode's hook is called both when the mode is enabled and when +it is disabled. + \(fn &optional ARG)" t nil) (defvar global-whitespace-mode nil "\ @@ -38998,22 +39133,23 @@ or call the function `global-whitespace-mode'.") (autoload 'global-whitespace-mode "whitespace" "\ Toggle whitespace visualization globally (Global Whitespace mode). -This is a minor mode. If called interactively, toggle the `Global -Whitespace mode' mode. If the prefix argument is positive, enable the -mode, and if it is zero or negative, disable the mode. +See also `whitespace-style', `whitespace-newline' and +`whitespace-display-mappings'. + +This is a global minor mode. If called interactively, toggle the +`Global Whitespace mode' mode. If the prefix argument is +positive, enable the mode, and if it is zero or negative, disable +the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='global-whitespace-mode)'. -The mode's hook is called both when the mode is enabled and when it is -disabled. - -See also `whitespace-style', `whitespace-newline' and -`whitespace-display-mappings'. +The mode's hook is called both when the mode is enabled and when +it is disabled. \(fn &optional ARG)" t nil) @@ -39030,20 +39166,6 @@ or call the function `global-whitespace-newline-mode'.") (autoload 'global-whitespace-newline-mode "whitespace" "\ Toggle global newline visualization (Global Whitespace Newline mode). -This is a minor mode. If called interactively, toggle the `Global -Whitespace-Newline mode' mode. If the prefix argument is positive, -enable the mode, and if it is zero or negative, disable the mode. - -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. - -To check whether the minor mode is enabled in the current buffer, -evaluate `(default-value \\='global-whitespace-newline-mode)'. - -The mode's hook is called both when the mode is enabled and when it is -disabled. - Use `global-whitespace-newline-mode' only for NEWLINE visualization exclusively. For other visualizations, including NEWLINE visualization together with (HARD) SPACEs and/or TABs, @@ -39051,6 +39173,21 @@ please use `global-whitespace-mode'. See also `whitespace-newline' and `whitespace-display-mappings'. +This is a global minor mode. If called interactively, toggle the +`Global Whitespace-Newline mode' mode. If the prefix argument is +positive, enable the mode, and if it is zero or negative, disable +the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. + +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value \\='global-whitespace-newline-mode)'. + +The mode's hook is called both when the mode is enabled and when +it is disabled. + \(fn &optional ARG)" t nil) (autoload 'whitespace-toggle-options "whitespace" "\ @@ -39363,19 +39500,19 @@ Show widget browser for WIDGET in other window. (autoload 'widget-minor-mode "wid-browse" "\ Minor mode for traversing widgets. -This is a minor mode. If called interactively, toggle the `Widget -minor mode' mode. If the prefix argument is positive, enable the -mode, and if it is zero or negative, disable the mode. +This is a minor mode. If called interactively, toggle the +`Widget minor mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `widget-minor-mode'. -The mode's hook is called both when the mode is enabled and when it is -disabled. +The mode's hook is called both when the mode is enabled and when +it is disabled. \(fn &optional ARG)" t nil) @@ -39482,19 +39619,19 @@ for a description of this minor mode.") (autoload 'windmove-mode "windmove" "\ Global minor mode for default windmove commands. -This is a minor mode. If called interactively, toggle the `Windmove -mode' mode. If the prefix argument is positive, enable the mode, and -if it is zero or negative, disable the mode. +This is a global minor mode. If called interactively, toggle the +`Windmove mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. To check whether the minor mode is enabled in the current buffer, evaluate `(default-value \\='windmove-mode)'. -The mode's hook is called both when the mode is enabled and when it is -disabled. +The mode's hook is called both when the mode is enabled and when +it is disabled. \(fn &optional ARG)" t nil) @@ -39646,20 +39783,6 @@ or call the function `winner-mode'.") (autoload 'winner-mode "winner" "\ Toggle Winner mode on or off. -This is a minor mode. If called interactively, toggle the `Winner -mode' mode. If the prefix argument is positive, enable the mode, and -if it is zero or negative, disable the mode. - -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. - -To check whether the minor mode is enabled in the current buffer, -evaluate `(default-value \\='winner-mode)'. - -The mode's hook is called both when the mode is enabled and when it is -disabled. - Winner mode is a global minor mode that records the changes in the window configuration (i.e. how the frames are partitioned into windows) so that the changes can be \"undone\" using the @@ -39667,6 +39790,20 @@ command `winner-undo'. By default this one is bound to the key sequence `C-c <left>'. If you change your mind (while undoing), you can press `C-c <right>' (calling `winner-redo'). +This is a global minor mode. If called interactively, toggle the +`Winner mode' mode. If the prefix argument is positive, enable +the mode, and if it is zero or negative, disable the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. + +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value \\='winner-mode)'. + +The mode's hook is called both when the mode is enabled and when +it is disabled. + \(fn &optional ARG)" t nil) (register-definition-prefixes "winner" '("winner-")) @@ -39721,6 +39858,65 @@ Default bookmark handler for Woman buffers. ;;;*** +;;;### (autoloads nil "word-wrap-mode" "textmodes/word-wrap-mode.el" +;;;;;; (0 0 0 0)) +;;; Generated autoloads from textmodes/word-wrap-mode.el + +(autoload 'word-wrap-whitespace-mode "word-wrap-mode" "\ +Allow `word-wrap' to fold on all breaking whitespace characters. + +The characters to break on are defined by `word-wrap-whitespace-characters'. + +This is a minor mode. If called interactively, toggle the +`Word-Wrap-Whitespace mode' mode. If the prefix argument is +positive, enable the mode, and if it is zero or negative, disable +the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. + +To check whether the minor mode is enabled in the current buffer, +evaluate `word-wrap-whitespace-mode'. + +The mode's hook is called both when the mode is enabled and when +it is disabled. + +\(fn &optional ARG)" t nil) + +(put 'global-word-wrap-whitespace-mode 'globalized-minor-mode t) + +(defvar global-word-wrap-whitespace-mode nil "\ +Non-nil if Global Word-Wrap-Whitespace mode is enabled. +See the `global-word-wrap-whitespace-mode' command +for a description of this minor mode. +Setting this variable directly does not take effect; +either customize it (see the info node `Easy Customization') +or call the function `global-word-wrap-whitespace-mode'.") + +(custom-autoload 'global-word-wrap-whitespace-mode "word-wrap-mode" nil) + +(autoload 'global-word-wrap-whitespace-mode "word-wrap-mode" "\ +Toggle Word-Wrap-Whitespace mode in all buffers. +With prefix ARG, enable Global Word-Wrap-Whitespace mode if ARG is +positive; otherwise, disable it. + +If called from Lisp, toggle the mode if ARG is `toggle'. +Enable the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. + +Word-Wrap-Whitespace mode is enabled in all buffers where +`word-wrap-whitespace-mode' would do it. + +See `word-wrap-whitespace-mode' for more information on +Word-Wrap-Whitespace mode. + +\(fn &optional ARG)" t nil) + +(register-definition-prefixes "word-wrap-mode" '("word-wrap-whitespace-characters")) + +;;;*** + ;;;### (autoloads nil "x-dnd" "x-dnd.el" (0 0 0 0)) ;;; Generated autoloads from x-dnd.el @@ -39971,20 +40167,6 @@ or call the function `xterm-mouse-mode'.") (autoload 'xterm-mouse-mode "xt-mouse" "\ Toggle XTerm mouse mode. -This is a minor mode. If called interactively, toggle the -`Xterm-Mouse mode' mode. If the prefix argument is positive, enable -the mode, and if it is zero or negative, disable the mode. - -If called from Lisp, toggle the mode if ARG is `toggle'. Enable the -mode if ARG is nil, omitted, or is a positive number. Disable the -mode if ARG is a negative number. - -To check whether the minor mode is enabled in the current buffer, -evaluate `(default-value \\='xterm-mouse-mode)'. - -The mode's hook is called both when the mode is enabled and when it is -disabled. - Turn it on to use Emacs mouse commands, and off to use xterm mouse commands. This works in terminal emulators compatible with xterm. It only works for simple uses of the mouse. Basically, only non-modified @@ -39992,6 +40174,20 @@ single clicks are supported. When turned on, the normal xterm mouse functionality for such clicks is still available by holding down the SHIFT key while pressing the mouse button. +This is a global minor mode. If called interactively, toggle the +`Xterm-Mouse mode' mode. If the prefix argument is positive, +enable the mode, and if it is zero or negative, disable the mode. + +If called from Lisp, toggle the mode if ARG is `toggle'. Enable +the mode if ARG is nil, omitted, or is a positive number. +Disable the mode if ARG is a negative number. + +To check whether the minor mode is enabled in the current buffer, +evaluate `(default-value \\='xterm-mouse-mode)'. + +The mode's hook is called both when the mode is enabled and when +it is disabled. + \(fn &optional ARG)" t nil) (register-definition-prefixes "xt-mouse" '("turn-o" "xt-mouse-epoch" "xterm-mouse-")) @@ -40121,10 +40317,10 @@ Zone out, completely." t nil) ;;;;;; "emacs-lisp/cl-seq.el" "emacs-lisp/debug-early.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" "emacs-lisp/lisp.el" "emacs-lisp/macroexp.el" -;;;;;; "emacs-lisp/map-ynp.el" "emacs-lisp/nadvice.el" "emacs-lisp/shorthands.el" -;;;;;; "emacs-lisp/syntax.el" "emacs-lisp/timer.el" "env.el" "epa-hook.el" -;;;;;; "erc/erc-autoaway.el" "erc/erc-button.el" "erc/erc-capab.el" -;;;;;; "erc/erc-compat.el" "erc/erc-dcc.el" "erc/erc-desktop-notifications.el" +;;;;;; "emacs-lisp/map-ynp.el" "emacs-lisp/nadvice.el" "emacs-lisp/oclosure.el" +;;;;;; "emacs-lisp/shorthands.el" "emacs-lisp/syntax.el" "emacs-lisp/timer.el" +;;;;;; "env.el" "epa-hook.el" "erc/erc-autoaway.el" "erc/erc-button.el" +;;;;;; "erc/erc-capab.el" "erc/erc-compat.el" "erc/erc-dcc.el" "erc/erc-desktop-notifications.el" ;;;;;; "erc/erc-ezbounce.el" "erc/erc-fill.el" "erc/erc-identd.el" ;;;;;; "erc/erc-imenu.el" "erc/erc-join.el" "erc/erc-list.el" "erc/erc-log.el" ;;;;;; "erc/erc-match.el" "erc/erc-menu.el" "erc/erc-netsplit.el" @@ -40134,14 +40330,14 @@ Zone out, completely." t nil) ;;;;;; "erc/erc-stamp.el" "erc/erc-status-sidebar.el" "erc/erc-track.el" ;;;;;; "erc/erc-truncate.el" "erc/erc-xdcc.el" "eshell/em-alias.el" ;;;;;; "eshell/em-banner.el" "eshell/em-basic.el" "eshell/em-cmpl.el" -;;;;;; "eshell/em-dirs.el" "eshell/em-glob.el" "eshell/em-hist.el" -;;;;;; "eshell/em-ls.el" "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" +;;;;;; "eshell/em-dirs.el" "eshell/em-elecslash.el" "eshell/em-glob.el" +;;;;;; "eshell/em-hist.el" "eshell/em-ls.el" "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" diff --git a/lisp/leim/quail/indian.el b/lisp/leim/quail/indian.el index 6641aa6b2e7..f2d5f9bad4a 100644 --- a/lisp/leim/quail/indian.el +++ b/lisp/leim/quail/indian.el @@ -696,4 +696,144 @@ Full key sequences are listed below:") (quail-defrule "|" ?‌) (quail-defrule "||" ?​) +(quail-define-package + "brahmi" "Brahmi" "ð‘€²" t "Brahmi phonetic input method. + + `\\=`' is used to switch levels instead of Alt-Gr. +" nil t t t t nil nil nil nil nil t) + +(quail-define-rules + ("``" ?₹) + ("1" ?ð‘§) + ("`1" ?1) + ("`!" ?ð‘’) + ("2" ?ð‘¨) + ("`2" ?2) + ("`@" ?ð‘“) + ("3" ?ð‘©) + ("`3" ?3) + ("`#" ?ð‘”) + ("4" ?ð‘ª) + ("`4" ?4) + ("`$" ?ð‘•) + ("5" ?ð‘«) + ("`5" ?5) + ("`%" ?ð‘–) + ("6" ?ð‘¬) + ("`6" ?6) + ("`^" ?ð‘—) + ("7" ?ð‘) + ("`7" ?7) + ("`&" ?ð‘˜) + ("8" ?ð‘®) + ("`8" ?8) + ("`*" ?ð‘™) + ("9" ?ð‘¯) + ("`9" ?9) + ("`\(" ?ð‘š) + ("0" ?ð‘¦) + ("`0" ?0) + ("`\)" ?ð‘›) + ("`-" ?ð‘œ) + ("`_" ?ð‘) + ("`=" ?ð‘ž) + ("`+" ?ð‘Ÿ) + ("`\\" ?ð‘‡) + ("`|" ?ð‘ˆ) + ("`" ?ð‘€) + ("q" ?ð‘€) + ("Q" ?𑀞) + ("`q" ?𑀃) + ("`Q" ?ð‘ ) + ("w" ?𑀟) + ("W" ?ð‘€ ) + ("`w" ?𑀄) + ("`W" ?ð‘¡) + ("e" ?ð‘‚) + ("E" ?ð‘ƒ) + ("`e" ?ð‘€) + ("`E" ?ð‘€) + ("r" ?ð‘€) + ("R" ?ð‘€¾) + ("`r" ?𑀋) + ("`R" ?𑀶) + ("t" ?ð‘€¢) + ("T" ?ð‘€£) + ("`t" ?ð‘¢) + ("y" ?𑀬) + ("Y" ?ð‘£) + ("`y" ?ð‘¤) + ("`Y" ?ð‘¥) + ("u" ?ð‘€¼) + ("U" ?ð‘€½) + ("`u" ?𑀉) + ("`U" ?𑀊) + ("i" ?𑀺) + ("I" ?ð‘€») + ("`i" ?𑀇) + ("`I" ?𑀈) + ("o" ?ð‘„) + ("O" ?ð‘…) + ("`o" ?𑀑) + ("`O" ?ð‘€’) + ("p" ?𑀧) + ("P" ?𑀨) + ("`p" ?ð‘³) + ("`P" ?ð‘±) + ("`\[" ?ð‘´) + ("`\{" ?ð‘²) + ("a" ?𑀸) + ("A" ?𑀆) + ("`a" ?ð‘€…) + ("`A" ?ð‘€¹) + ("s" ?ð‘€²) + ("S" ?ð‘€°) + ("`s" ?ð‘€±) + ("d" ?𑀤) + ("D" ?ð‘€¥) + ("`d" ?𑀶) + ("f" ?ð‘†) + ("F" ?𑀿) + ("`f" ?𑀌) + ("`F" ?ð‘°) + ("g" ?𑀕) + ("G" ?ð‘€–) + ("h" ?ð‘€³) + ("H" ?𑀂) + ("j" ?𑀚) + ("J" ?ð‘€›) + ("k" ?𑀓) + ("K" ?ð‘€”) + ("l" ?ð‘€®) + ("L" ?ð‘€´) + ("`l" ?ð‘€µ) + ("`L" ?ð‘µ) + ("z" ?ð‘€) + ("Z" ?ð‘€) + ("`z" ?ð‘) + ("`Z" ?𑀎) + ("x" ?ð‘‰) + ("X" ?ð‘Š) + ("`x" ?ð‘‹) + ("`X" ?ð‘Œ) + ("c" ?𑀘) + ("C" ?ð‘€™) + ("`c" #x200C) ; ZWNJ + ("`C" #x200D) ; ZWJ + ("v" ?𑀯) + ("V" ?ð‘€·) + ("b" ?𑀩) + ("B" ?𑀪) + ("n" ?𑀦) + ("N" ?𑀡) + ("`n" ?ð‘€—) + ("`N" ?𑀜) + ("m" ?𑀫) + ("M" ?ð‘€) + ("`m" ?ð‘€€) + ("<" ?ð‘) + ("`/" ?ð‘¿) + ) + + ;;; indian.el ends here diff --git a/lisp/linum.el b/lisp/linum.el index e121618b69f..d491da52066 100644 --- a/lisp/linum.el +++ b/lisp/linum.el @@ -74,6 +74,9 @@ and you have to scroll or press \\[recenter-top-bottom] to update the numbers." ;;;###autoload (define-minor-mode linum-mode "Toggle display of line numbers in the left margin (Linum mode). +This mode has been largely replaced by `display-line-numbers-mode' +(which is much faster and has fewer interaction problems with other +modes). Linum mode is a buffer-local minor mode." :lighter "" ; for desktop.el diff --git a/lisp/ls-lisp.el b/lisp/ls-lisp.el index 7a4be3c7e4c..33dd98ef8d2 100644 --- a/lisp/ls-lisp.el +++ b/lisp/ls-lisp.el @@ -891,7 +891,7 @@ All ls time options, namely c, t and u, are handled." nil) (defun ls-lisp--sanitize-switches (switches) - "Convert long options of GNU 'ls' to their short form. + "Convert long options of GNU \"ls\" to their short form. Conversion is done only for flags supported by ls-lisp. Long options not supported by ls-lisp are removed. Supported options are: A a B C c F G g h i n R r S s t U u v X. diff --git a/lisp/mail/emacsbug.el b/lisp/mail/emacsbug.el index 1bda609d105..8cb4a00009f 100644 --- a/lisp/mail/emacsbug.el +++ b/lisp/mail/emacsbug.el @@ -488,7 +488,14 @@ and send the mail again%s." Interactively, you will be prompted for SUBJECT and a patch FILE name (which will be attached to the mail). You will end up in a Message buffer where you can explain more about the patch." - (interactive "sThis patch is about: \nfPatch file name: ") + (interactive + (let* ((file (read-file-name "Patch file name: ")) + (guess (with-temp-buffer + (insert-file-contents file) + (mail-fetch-field "Subject")))) + (list (read-string (format-prompt "This patch is about" guess) + nil nil guess) + file))) (switch-to-buffer "*Patch Help*") (let ((inhibit-read-only t)) (erase-buffer) diff --git a/lisp/mail/feedmail.el b/lisp/mail/feedmail.el index 32edc292619..35e9f73f8cf 100644 --- a/lisp/mail/feedmail.el +++ b/lisp/mail/feedmail.el @@ -1317,7 +1317,7 @@ feedmail-queue-buffer-file-name is restored to nil. Example advice for mail-send: - (advice-add 'mail-send :around #'my-feedmail-mail-send-advice) + (advice-add \\='mail-send :around #\\='my-feedmail-mail-send-advice) (defun my-feedmail-mail-send-advice (orig-fun &rest args) (let ((feedmail-queue-buffer-file-name buffer-file-name) (buffer-file-name nil)) @@ -1742,7 +1742,7 @@ applied to a file after you've just read it from disk: for example, a feedmail FQM message file from a queue. You could use something like this: - (add-to-list 'auto-mode-alist \\='(\"\\\\.fqm\\\\\\='\" . feedmail-vm-mail-mode))" + (add-to-list \\='auto-mode-alist \\='(\"\\\\.fqm\\\\\\='\" . feedmail-vm-mail-mode))" (feedmail-say-debug ">in-> feedmail-vm-mail-mode") (let ((the-buf (current-buffer))) (vm-mail) diff --git a/lisp/mail/ietf-drums-date.el b/lisp/mail/ietf-drums-date.el index 6f64ae73377..ddef7f11b66 100644 --- a/lisp/mail/ietf-drums-date.el +++ b/lisp/mail/ietf-drums-date.el @@ -50,8 +50,8 @@ See the decoded-time defstruct.") '((0 60) (0 59) (0 23) (1 31) (1 12) (1 9999)) "Numeric slot ranges, for bounds checking. Note that RFC5322 explicitly requires that seconds go up to 60, -to allow for leap seconds (see Mills, D., 'Network Time -Protocol', STD 12, RFC 1119, September 1989).") +to allow for leap seconds (see Mills, D., \"Network Time +Protocol\", STD 12, RFC 1119, September 1989).") (defsubst ietf-drums-date--ignore-char-p (char) ;; Ignore whitespace and commas. diff --git a/lisp/menu-bar.el b/lisp/menu-bar.el index d8c8c760f78..9a3181afb8d 100644 --- a/lisp/menu-bar.el +++ b/lisp/menu-bar.el @@ -311,7 +311,7 @@ (isearch-update-ring string t) (re-search-backward string))) -;; The Edit->Search->Incremental Search menu +;; The Edit->Incremental Search menu (defvar menu-bar-i-search-menu (let ((menu (make-sparse-keymap "Incremental Search"))) (bindings--define-key menu [isearch-forward-symbol-at-point] @@ -339,12 +339,6 @@ (defvar menu-bar-search-menu (let ((menu (make-sparse-keymap "Search"))) - - (bindings--define-key menu [i-search] - `(menu-item "Incremental Search" ,menu-bar-i-search-menu)) - (bindings--define-key menu [separator-tag-isearch] - menu-bar-separator) - (bindings--define-key menu [tags-continue] '(menu-item "Continue Tags Search" fileloop-continue :enable (and (featurep 'fileloop) @@ -501,6 +495,9 @@ (bindings--define-key menu [replace] `(menu-item "Replace" ,menu-bar-replace-menu)) + (bindings--define-key menu [i-search] + `(menu-item "Incremental Search" ,menu-bar-i-search-menu)) + (bindings--define-key menu [search] `(menu-item "Search" ,menu-bar-search-menu)) diff --git a/lisp/mh-e/mh-limit.el b/lisp/mh-e/mh-limit.el index a2ea7610139..3e731e22a1f 100644 --- a/lisp/mh-e/mh-limit.el +++ b/lisp/mh-e/mh-limit.el @@ -143,7 +143,7 @@ Use \\<mh-folder-mode-map>\\[mh-widen] to undo this command." ;;; Support Routines (defun mh-subject-to-sequence (all) - "Put all following messages with same subject in sequence 'subject. + "Put all following messages with same subject in sequence `subject'. If arg ALL is t, move to beginning of folder buffer to collect all messages. If arg ALL is nil, collect only messages from current one on forward. @@ -161,7 +161,7 @@ Return number of messages put in the sequence: (mh-subject-to-sequence-unthreaded all))) (defun mh-subject-to-sequence-threaded (all) - "Put all messages with the same subject in the 'subject sequence. + "Put all messages with the same subject in the `subject' sequence. This function works when the folder is threaded. In this situation the subject could get truncated and so the normal @@ -192,7 +192,7 @@ are taken into account." It would be desirable to avoid hard-coding this.") (defun mh-subject-to-sequence-unthreaded (all) - "Put all following messages with same subject in sequence 'subject. + "Put all following messages with same subject in sequence `subject'. This function only works with an unthreaded folder. If arg ALL is t, move to beginning of folder buffer to collect all messages. If diff --git a/lisp/mh-e/mh-mime.el b/lisp/mh-e/mh-mime.el index 98a20b7bb4f..d2e07977e5d 100644 --- a/lisp/mh-e/mh-mime.el +++ b/lisp/mh-e/mh-mime.el @@ -1764,7 +1764,7 @@ initialized. Always use the command `mh-have-file-command'.") ;;;###mh-autoload (defun mh-have-file-command () "Return t if `file' command is on the system. -'file -i' is used to get MIME type of composition insertion." +\"file -i\" is used to get MIME type of composition insertion." (when (eq mh-have-file-command 'undefined) (setq mh-have-file-command (and (executable-find "file") ; file command exists diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index f60af482da2..fb473cf71b0 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -864,7 +864,11 @@ Intended to be called via `clear-message-function'." (setq minibuffer-message-timer nil)) (when (overlayp minibuffer-message-overlay) (delete-overlay minibuffer-message-overlay) - (setq minibuffer-message-overlay nil)))) + (setq minibuffer-message-overlay nil))) + + ;; Return nil telling the caller that the message + ;; should be also handled by the caller. + nil) (setq clear-message-function 'clear-minibuffer-message) @@ -1136,6 +1140,7 @@ Moves point to the end of the new text." ;; The properties on `newtext' include things like the ;; `completions-first-difference' face, which we don't want to ;; include upon insertion. + (setq newtext (copy-sequence newtext)) ;Don't modify the arg by side-effect. (if minibuffer-allow-text-properties ;; If we're preserving properties, then just remove the faces ;; and other properties added by the completion machinery. @@ -1895,9 +1900,7 @@ completions." :version "28.1") (defcustom completions-header-format - (propertize "%s possible completions:\n" - 'face 'shadow - :help "Please select a completion") + (propertize "%s possible completions:\n" 'face 'shadow) "Format of completions header. It may contain one %s to show the total count of completions. When nil, no header is shown." @@ -4103,7 +4106,7 @@ This turns into (prefix \"f\" any \"o\" any \"o\" any point) which is at the core of flex logic. The extra -'any' is optimized away later on." +`any' is optimized away later on." (mapcan (lambda (elem) (if (stringp elem) (mapcan (lambda (char) @@ -4247,6 +4250,7 @@ See `completing-read' for the meaning of the arguments." ;; override bindings in base-keymap. base-keymap))) (buffer (current-buffer)) + (c-i-c completion-ignore-case) (result (minibuffer-with-setup-hook (lambda () @@ -4256,7 +4260,9 @@ See `completing-read' for the meaning of the arguments." (setq-local minibuffer-completion-confirm (unless (eq require-match t) require-match)) (setq-local minibuffer--require-match require-match) - (setq-local minibuffer--original-buffer buffer)) + (setq-local minibuffer--original-buffer buffer) + ;; Copy the value from original buffer to the minibuffer. + (setq-local completion-ignore-case c-i-c)) (read-from-minibuffer prompt initial-input keymap nil hist def inherit-input-method)))) (when (and (equal result "") def) diff --git a/lisp/mouse.el b/lisp/mouse.el index b66cfad4878..0446bc6dd87 100644 --- a/lisp/mouse.el +++ b/lisp/mouse.el @@ -42,7 +42,9 @@ :group 'editing) (defcustom mouse-yank-at-point nil - "If non-nil, mouse yank commands yank at point instead of at click." + "If non-nil, mouse yank commands yank at point instead of at click. +This also allows yanking text into an isearch without moving the +mouse cursor to the echo area." :type 'boolean) (defcustom mouse-drag-copy-region nil @@ -165,6 +167,17 @@ Expects to be bound to `(double-)mouse-1' in `key-translation-map'." (define-key key-translation-map [double-mouse-1] #'mouse--click-1-maybe-follows-link) +(defun mouse-double-click-time () + "Return a number for `double-click-time'. +In contrast to using the `double-click-time' variable directly, +which could be set to nil or t, this function is guaranteed to +always return a positive integer or zero." + (let ((ct double-click-time)) + (cond ((eq ct t) 10000) ; arbitrary number useful for sit-for + ((eq ct nil) 0) + ((and (numberp ct) (> ct 0)) ct) + (t 0)))) + ;; Provide a mode-specific menu on a mouse button. diff --git a/lisp/net/dictionary-connection.el b/lisp/net/dictionary-connection.el index aef3c4efc74..a4afcd6647d 100644 --- a/lisp/net/dictionary-connection.el +++ b/lisp/net/dictionary-connection.el @@ -83,10 +83,10 @@ Return a data structure identifying the connection." "Return the status of the CONNECTION. Possible return values are the symbols: nil: argument is not a connection object - 'none: argument is not connected - 'up: connection is open and buffer is existing - 'down: connection is closed - 'alone: connection is not associated with a buffer" + `none': argument is not connected + `up': connection is open and buffer is existing + `down': connection is closed + `alone': connection is not associated with a buffer" (when (dictionary-connection-p connection) (let ((process (dictionary-connection-process connection)) (buffer (dictionary-connection-buffer connection))) diff --git a/lisp/net/eudc-bob.el b/lisp/net/eudc-bob.el index 6a2cd13dd03..f543678fa2d 100644 --- a/lisp/net/eudc-bob.el +++ b/lisp/net/eudc-bob.el @@ -124,7 +124,7 @@ LABEL." (let (overlay (p (point)) prop val) - (insert label) + (insert (or label "")) (put-text-property p (point) 'face 'bold) (setq overlay (make-overlay p (point))) (overlay-put overlay 'mouse-face 'highlight) diff --git a/lisp/net/eudc-vars.el b/lisp/net/eudc-vars.el index d58fab896ed..90d89e87fba 100644 --- a/lisp/net/eudc-vars.el +++ b/lisp/net/eudc-vars.el @@ -425,6 +425,15 @@ BBDB fields. SPECs are sexps which are evaluated: (symbol :tag "BBDB Field") (sexp :tag "Conversion Spec")))) +(defcustom eudc-ldap-no-wildcard-attributes + '(objectclass objectcategory) + "LDAP attributes which are always searched for without wildcard character. +This is the list of special dictionary-valued attributes, where +wildcarded search may fail. For example, it fails with +objectclass in Active Directory servers." + :type '(repeat (symbol :tag "Directory attribute"))) + + ;;}}} ;;{{{ BBDB Custom Group diff --git a/lisp/net/eudc.el b/lisp/net/eudc.el index 6ce89ce5be4..808d2ca509c 100644 --- a/lisp/net/eudc.el +++ b/lisp/net/eudc.el @@ -174,7 +174,7 @@ Value is the new string." "Folding white space.") (defconst eudc-rfc5322-cctext-token "\u005D-\u007E\u002A-\u005B\u0021-\u0027" - "Printable US-ASCII characters not including '(', ')', or '\\'.") + "Printable US-ASCII characters not including \"(\", \")\", or \"\\\".") (defun eudc-rfc5322-quote-phrase (string) "Quote STRING if it needs quoting as a phrase in a header." diff --git a/lisp/net/eudcb-ldap.el b/lisp/net/eudcb-ldap.el index 365dace961a..1201c84f2d3 100644 --- a/lisp/net/eudcb-ldap.el +++ b/lisp/net/eudcb-ldap.el @@ -151,16 +151,20 @@ attribute names are returned. Default to `person'." (interactive) (or eudc-server (call-interactively 'eudc-set-server)) - (let ((ldap-host-parameters-alist - (list (cons eudc-server - '(scope subtree sizelimit 1))))) - (mapcar #'eudc-ldap-cleanup-record-filtering-addresses - (ldap-search - (eudc-ldap-format-query-as-rfc1558 - (list (cons "objectclass" - (or objectclass - "person")))) - eudc-server nil t)))) + (let ((plist (copy-sequence + (alist-get eudc-server ldap-host-parameters-alist + nil nil #'equal)))) + (plist-put plist 'scope 'subtree) + (plist-put plist 'sizelimit '1) + (let ((ldap-host-parameters-alist + (list (cons eudc-server plist)))) + (mapcar #'eudc-ldap-cleanup-record-filtering-addresses + (ldap-search + (eudc-ldap-format-query-as-rfc1558 + (list (cons 'objectclass + (or objectclass + "person")))) + eudc-server nil t))))) (defun eudc-ldap-escape-query-special-chars (string) "Value is STRING with characters forbidden in LDAP queries escaped." @@ -178,12 +182,17 @@ attribute names are returned. Default to `person'." (defun eudc-ldap-format-query-as-rfc1558 (query) "Format the EUDC QUERY list as a RFC1558 LDAP search filter." - (let ((formatter (lambda (item &optional wildcard) - (format "(%s=%s)" - (car item) - (concat - (eudc-ldap-escape-query-special-chars - (cdr item)) (if wildcard "*" "")))))) + (let ((formatter + (lambda (item &optional wildcard) + (format "(%s=%s)" + (car item) + (concat + (eudc-ldap-escape-query-special-chars + (cdr item)) + (if (and wildcard + (not (memq (car item) + eudc-ldap-no-wildcard-attributes))) + "*" "")))))) (format "(&%s)" (concat (mapconcat formatter (butlast query) "") diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 75dc679a3dd..57cb566c95d 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -311,7 +311,7 @@ parameter, and should return the (possibly) transformed URL." (defvar eww-accept-content-types "text/html, text/plain, text/sgml, text/css, application/xhtml+xml, */*;q=0.01" - "Value used for the HTTP 'Accept' header.") + "Value used for the HTTP \"Accept\" header.") (defvar-keymap eww-link-keymap :parent shr-map diff --git a/lisp/net/ldap.el b/lisp/net/ldap.el index ce6c270e0bc..da45457891b 100644 --- a/lisp/net/ldap.el +++ b/lisp/net/ldap.el @@ -148,7 +148,7 @@ Valid properties include: "The name of the ldapsearch command line program." :type '(string :tag "`ldapsearch' Program")) -(defcustom ldap-ldapsearch-args '("-LL" "-tt") +(defcustom ldap-ldapsearch-args '("-LLL" "-tt") "A list of additional arguments to pass to `ldapsearch'." :type '(repeat :tag "`ldapsearch' Arguments" (string :tag "Argument"))) @@ -663,7 +663,7 @@ an alist of attribute/value pairs." (while (not (memq (process-status proc) '(exit signal))) (sit-for 0.1)) (let ((status (process-exit-status proc))) - (when (not (eq status 0)) + (when (not (memql status '(0 4))) ; 4 = Size limit exceeded ;; Handle invalid credentials exit status specially ;; for ldap-password-read. (if (eq status 49) @@ -682,7 +682,7 @@ an alist of attribute/value pairs." (while (re-search-forward (concat "[\t\n\f]+ \\|" ldap-ldapsearch-password-prompt-regexp) nil t) - (replace-match "" nil nil)) + (replace-match "")) (goto-char (point-min)) (if (looking-at "usage") @@ -691,7 +691,6 @@ an alist of attribute/value pairs." ;; Skip error message when retrieving attribute list (if (looking-at "Size limit exceeded") (forward-line 1)) - (if (looking-at "version:") (forward-line 1)) ;bug#12724. (while (progn (skip-chars-forward " \t\n") (not (eobp))) @@ -699,7 +698,7 @@ an alist of attribute/value pairs." (forward-line 1) (while (looking-at "^\\([A-Za-z][-A-Za-z0-9]*\ \\|[0-9]+\\(?:\\.[0-9]+\\)*\\)\\(;[-A-Za-z0-9]+\\)*[=:\t ]+\ -\\(<[\t ]*file://\\)\\(.*\\)$") +\\(<[\t ]*file://\\)?\\(.*\\)$") (setq name (match-string 1) value (match-string 4)) ;; Need to handle file:///D:/... as generated by OpenLDAP @@ -724,7 +723,6 @@ an alist of attribute/value pairs." (record (push (nreverse record) result))) (setq record nil) - (skip-chars-forward " \t\n") (message "Parsing results... %d" numres) (setq numres (1+ numres))) (message "Parsing results... done") diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 9d1600ed72f..0d30b349229 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -433,6 +433,20 @@ will be killed." :version "28.1" :type 'boolean) +(defcustom rcirc-cycle-completion-flag nil + "Non-nil means to use cycling for completion in rcirc buffers. +See the Info node `(emacs) Completion Options' for background on +what cycling completion means." + :version "29.1" + :set (lambda (sym val) + (dolist (buf (match-buffers '(major-mode . rcirc-mode))) + (with-current-buffer buf + (if val + (setq-local completion-cycle-threshold t) + (kill-local-variable 'completion-cycle-threshold)))) + (set-default sym val)) + :type 'boolean) + (defvar-local rcirc-nick nil "The nickname used for the current connection.") @@ -757,18 +771,26 @@ SERVER-PLIST is the property list for the server." (yes-or-no-p "Encrypt connection?")) 'tls 'plain)) +(defvar rcirc-reconnect-delay) (defun rcirc-keepalive () "Send keep alive pings to active rcirc processes. Kill processes that have not received a server message since the last ping." (if (rcirc-process-list) (mapc (lambda (process) - (with-rcirc-process-buffer process - (when (not rcirc-connecting) - (rcirc-send-ctcp process - rcirc-nick - (format "KEEPALIVE %f" - (float-time)))))) + (with-rcirc-process-buffer process + (when (not rcirc-connecting) + (condition-case nil + (rcirc-send-ctcp process + rcirc-nick + (format "KEEPALIVE %f" + (float-time))) + (rcirc-closed-connection + (if (zerop rcirc-reconnect-delay) + (message "rcirc: Connection to %s closed" + (process-name process)) + (rcirc-reconnect process)) + (message "")))))) (rcirc-process-list)) ;; no processes, clean up timer (when (timerp rcirc-keepalive-timer) @@ -1060,17 +1082,18 @@ Note that the messages are stored in reverse order.") ;; expression and `rcirc-process-regexp'. (error "Malformed tag %S" tag)) (cons (match-string 1 tag) - (replace-regexp-in-string - (rx (* ?\\ ?\\) ?\\ (any ?: ?s ?\\ ?r ?n)) - (lambda (rep) - (concat (substring rep 0 -2) - (cl-case (aref rep (1- (length rep))) - (?: ";") - (?s " ") - (?\\ "\\\\") - (?r "\r") - (?n "\n")))) - (match-string 2 tag)))) + (when (match-string 2 tag) + (replace-regexp-in-string + (rx (* ?\\ ?\\) ?\\ (any ?: ?s ?\\ ?r ?n)) + (lambda (rep) + (concat (substring rep 0 -2) + (cl-case (aref rep (1- (length rep))) + (?: ";") + (?s " ") + (?\\ "\\\\") + (?r "\r") + (?n "\n")))) + (match-string 2 tag))))) (split-string tag-data ";")))) rcirc-message-tags)) (user (match-string 3 text)) @@ -1122,6 +1145,8 @@ used as the message body." "Check if PROCESS is open or running." (memq (process-status process) '(run open))) +(define-error 'rcirc-closed-connection "Network connection not open") + (defun rcirc-send-string (process &rest parts) "Send PROCESS a PARTS plus a newline. PARTS may contain a `:' symbol, to designate that the next string @@ -1139,8 +1164,7 @@ element in PARTS is a list, append it to PARTS." rcirc-encode-coding-system) "\n"))) (unless (rcirc--connection-open-p process) - (error "Network connection to %s is not open" - (process-name process))) + (signal 'rcirc-closed-connection process)) (rcirc-debug process string) (process-send-string process string))) @@ -1434,7 +1458,8 @@ PROCESS is the process object used for communication. (add-hook 'completion-at-point-functions 'rcirc-completion-at-point nil 'local) - (setq-local completion-cycle-threshold t) + (when rcirc-cycle-completion-flag + (setq-local completion-cycle-threshold t)) (run-mode-hooks 'rcirc-mode-hook)) @@ -2592,15 +2617,22 @@ that, an interactive form can specified." (defun ,fn-name (,argument &optional process target) ,(concat documentation "\n\nNote: If PROCESS or TARGET are nil, the values given" - "\nby `rcirc-buffer-process' and `rcirc-target' will be used.") - (interactive (list ,interactive-spec)) + "\nby `rcirc-buffer-process' and `rcirc-target' will be used.") + (interactive ,(if (stringp interactive-spec) + ;; HACK: Necessary to wrap the result of + ;; the interactive spec in a list. + `(list (call-interactively + (lambda (&rest args) + (interactive ,interactive-spec) + args))) + `(list ,interactive-spec))) (unless (if (listp ,argument) (<= ,required (length ,argument) ,total) (string-match ,regexp ,argument)) (user-error "Malformed input (%s): %S" ',command ,argument)) (push ,(upcase (symbol-name command)) rcirc-pending-requests) (let ((process (or process (rcirc-buffer-process))) - (target (or target rcirc-target))) + (target (or target rcirc-target))) (ignore target process) (let (,@(cl-loop for i from 0 for arg in (delq '&optional arguments) diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index d897594f8d8..251d5191cb2 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -548,28 +548,8 @@ Emacs dired can't find files." (defun tramp-adb-handle-write-region (start end filename &optional append visit lockname mustbenew) "Like `write-region' for Tramp files." - (setq filename (expand-file-name filename) - lockname (file-truename (or lockname filename))) - (with-parsed-tramp-file-name filename nil - (when (and mustbenew (file-exists-p filename) - (or (eq mustbenew 'excl) - (not - (y-or-n-p - (format "File %s exists; overwrite anyway?" filename))))) - (tramp-error v 'file-already-exists filename)) - - (let ((file-locked (eq (file-locked-p lockname) t)) - (curbuf (current-buffer)) - (tmpfile (tramp-compat-make-temp-file filename))) - - ;; Lock file. - (when (and (not (auto-save-file-name-p (file-name-nondirectory filename))) - (file-remote-p lockname) - (not file-locked)) - (setq file-locked t) - ;; `lock-file' exists since Emacs 28.1. - (tramp-compat-funcall 'lock-file lockname)) - + (tramp-skeleton-write-region start end filename append visit lockname mustbenew + (let ((tmpfile (tramp-compat-make-temp-file filename))) (when (and append (file-exists-p filename)) (copy-file filename tmpfile 'ok) (set-file-modes tmpfile (logior (or (file-modes tmpfile) 0) #o0600))) @@ -582,33 +562,7 @@ Emacs dired can't find files." (unless (tramp-adb-execute-adb-command v "push" tmpfile (tramp-compat-file-name-unquote localname)) (tramp-error v 'file-error "Cannot write: `%s'" filename)) - (delete-file tmpfile))) - - ;; We must also flush the cache of the directory, because - ;; `file-attributes' reads the values from there. - (tramp-flush-file-properties v localname) - - (unless (equal curbuf (current-buffer)) - (tramp-error - v 'file-error - "Buffer has changed from `%s' to `%s'" curbuf (current-buffer))) - - ;; 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. - (tramp-compat-funcall 'unlock-file lockname)) - - ;; The end. - (when (and (null noninteractive) - (or (eq visit t) (string-or-null-p visit))) - (tramp-message v 0 "Wrote %s" filename)) - (run-hooks 'tramp-handle-write-region-hook)))) + (delete-file tmpfile)))))) (defun tramp-adb-handle-set-file-modes (filename mode &optional flag) "Like `set-file-modes' for Tramp files." diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el index 7f4eca3f7c7..4a020c7150f 100644 --- a/lisp/net/tramp-archive.el +++ b/lisp/net/tramp-archive.el @@ -362,14 +362,13 @@ arguments to pass to the OPERATION." (progn (defun tramp-archive-autoload-file-name-handler (operation &rest args) "Load Tramp archive file name handler, and perform OPERATION." (defvar tramp-archive-autoload) - (when tramp-archive-enabled - ;; We cannot use `tramp-compat-temporary-file-directory' here due - ;; to autoload. When installing Tramp's GNU ELPA package, there - ;; might be an older, incompatible version active. We try to - ;; overload this. - (let ((default-directory temporary-file-directory) - (tramp-archive-autoload t)) - (apply #'tramp-autoload-file-name-handler operation args))))) + (let (;; We cannot use `tramp-compat-temporary-file-directory' here + ;; due to autoload. When installing Tramp's GNU ELPA package, + ;; there might be an older, incompatible version active. We + ;; try to overload this. + (default-directory temporary-file-directory) + (tramp-archive-autoload tramp-archive-enabled)) + (apply #'tramp-autoload-file-name-handler operation args)))) (put #'tramp-archive-autoload-file-name-handler 'tramp-autoload t) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index a8f265223f9..ba4cdb0ab52 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -1205,12 +1205,18 @@ component is used as the target of the symlink." ;; The scripts could fail, for example with huge file size. (tramp-do-file-attributes-with-ls v localname id-format)))))))) +(defconst tramp-sunos-unames (regexp-opt '("SunOS 5.10" "SunOS 5.11")) + "Regexp to determine remote SunOS.") + (defun tramp-sh--quoting-style-options (vec) "Quoting style options to be used for VEC." (or (tramp-get-ls-command-with vec "--quoting-style=literal --show-control-chars") - (tramp-get-ls-command-with vec "-w") + ;; ls on Solaris does not return an error in that case. We've got + ;; reports for "SunOS 5.11" so far. + (unless (tramp-check-remote-uname vec tramp-sunos-unames) + (tramp-get-ls-command-with vec "-w")) "")) (defun tramp-do-file-attributes-with-ls (vec localname &optional id-format) @@ -3322,251 +3328,197 @@ implementation will be used." (defun tramp-sh-handle-write-region (start end filename &optional append visit lockname mustbenew) "Like `write-region' for Tramp files." - (setq filename (expand-file-name filename) - lockname (file-truename (or lockname filename))) - (with-parsed-tramp-file-name filename nil - (when (and mustbenew (file-exists-p filename) - (or (eq mustbenew 'excl) - (not - (y-or-n-p - (format "File %s exists; overwrite anyway?" filename))))) - (tramp-error v 'file-already-exists filename)) - - (let ((file-locked (eq (file-locked-p lockname) t)) - (uid (or (file-attribute-user-id (file-attributes filename 'integer)) - (tramp-get-remote-uid v 'integer))) - (gid (or (file-attribute-group-id (file-attributes filename 'integer)) - (tramp-get-remote-gid v 'integer)))) - - ;; Lock file. - (when (and (not (auto-save-file-name-p (file-name-nondirectory filename))) - (file-remote-p lockname) - (not file-locked)) - (setq file-locked t) - ;; `lock-file' exists since Emacs 28.1. - (tramp-compat-funcall 'lock-file lockname)) - - (if (and (tramp-local-host-p v) - ;; `file-writable-p' calls `file-expand-file-name'. We - ;; cannot use `tramp-run-real-handler' therefore. - (file-writable-p (file-name-directory localname)) - (or (file-directory-p localname) - (file-writable-p localname))) - ;; Short track: if we are on the local host, we can run directly. - (let ((create-lockfiles (not file-locked))) - (write-region start end localname append 'no-message lockname)) - - (let* ((modes (tramp-default-file-modes - filename (and (eq mustbenew 'excl) 'nofollow))) - ;; We use this to save the value of - ;; `last-coding-system-used' after writing the tmp - ;; file. At the end of the function, we set - ;; `last-coding-system-used' to this saved value. This - ;; way, any intermediary coding systems used while - ;; talking to the remote shell or suchlike won't hose - ;; this variable. This approach was snarfed from - ;; ange-ftp.el. - coding-system-used - ;; Write region into a tmp file. This isn't really - ;; needed if we use an encoding function, but currently - ;; we use it always because this makes the logic - ;; simpler. We must also set `temporary-file-directory', - ;; because it could point to a remote directory. - (temporary-file-directory tramp-compat-temporary-file-directory) - (tmpfile (or tramp-temp-buffer-file-name - (tramp-compat-make-temp-file filename)))) - - ;; If `append' is non-nil, we copy the file locally, and let - ;; the native `write-region' implementation do the job. - (when (and append (file-exists-p filename)) - (copy-file filename tmpfile 'ok)) - - ;; We say `no-message' here because we don't want the - ;; visited file modtime data to be clobbered from the temp - ;; file. We call `set-visited-file-modtime' ourselves later - ;; on. We must ensure that `file-coding-system-alist' - ;; matches `tmpfile'. - (let ((file-coding-system-alist - (tramp-find-file-name-coding-system-alist filename tmpfile)) - create-lockfiles) - (condition-case err - (write-region start end tmpfile append 'no-message) - ((error quit) - (setq tramp-temp-buffer-file-name nil) - (delete-file tmpfile) - (signal (car err) (cdr err)))) - - ;; Now, `last-coding-system-used' has the right value. Remember it. - (setq coding-system-used last-coding-system-used)) - - ;; The permissions of the temporary file should be set. If - ;; FILENAME does not exist (eq modes nil) it has been - ;; renamed to the backup file. This case `save-buffer' - ;; handles permissions. - ;; Ensure that it is still readable. - (when modes - (set-file-modes tmpfile (logior (or modes 0) #o0400))) - - ;; This is a bit lengthy due to the different methods - ;; possible for file transfer. First, we check whether the - ;; method uses an scp program. If so, we call it. - ;; Otherwise, both encoding and decoding command must be - ;; specified. However, if the method _also_ specifies an - ;; encoding function, then that is used for encoding the - ;; contents of the tmp file. - (let* ((size (file-attribute-size (file-attributes tmpfile))) - (rem-dec (tramp-get-inline-coding v "remote-decoding" size)) - (loc-enc (tramp-get-inline-coding v "local-encoding" size))) - (cond - ;; `copy-file' handles direct copy and out-of-band methods. - ((or (tramp-local-host-p v) - (tramp-method-out-of-band-p v size)) - (if (and (not (stringp start)) - (= (or end (point-max)) (point-max)) - (= (or start (point-min)) (point-min)) - (tramp-get-method-parameter v 'tramp-copy-keep-tmpfile)) - (progn - (setq tramp-temp-buffer-file-name tmpfile) - (condition-case err - ;; We keep the local file for performance - ;; reasons, useful for "rsync". - (copy-file tmpfile filename t) - ((error quit) - (setq tramp-temp-buffer-file-name nil) - (delete-file tmpfile) - (signal (car err) (cdr err))))) - (setq tramp-temp-buffer-file-name nil) - ;; Don't rename, in order to keep context in SELinux. - (unwind-protect - (copy-file tmpfile filename t) - (delete-file tmpfile)))) - - ;; Use inline file transfer. - (rem-dec - ;; Encode tmpfile. + (tramp-skeleton-write-region start end filename append visit lockname mustbenew + (if (and (tramp-local-host-p v) + ;; `file-writable-p' calls `file-expand-file-name'. We + ;; cannot use `tramp-run-real-handler' therefore. + (file-writable-p (file-name-directory localname)) + (or (file-directory-p localname) + (file-writable-p localname))) + ;; Short track: if we are on the local host, we can run directly. + (let ((create-lockfiles (not file-locked))) + (write-region start end localname append 'no-message lockname)) + + (let* ((modes (tramp-default-file-modes + filename (and (eq mustbenew 'excl) 'nofollow))) + ;; We use this to save the value of + ;; `last-coding-system-used' after writing the tmp file. + ;; At the end of the function, we set + ;; `last-coding-system-used' to this saved value. This + ;; way, any intermediary coding systems used while + ;; talking to the remote shell or suchlike won't hose + ;; this variable. This approach was snarfed from + ;; ange-ftp.el. + coding-system-used + ;; Write region into a tmp file. This isn't really + ;; needed if we use an encoding function, but currently + ;; we use it always because this makes the logic simpler. + ;; We must also set `temporary-file-directory', because + ;; it could point to a remote directory. + (temporary-file-directory + tramp-compat-temporary-file-directory) + (tmpfile (or tramp-temp-buffer-file-name + (tramp-compat-make-temp-file filename)))) + + ;; If `append' is non-nil, we copy the file locally, and let + ;; the native `write-region' implementation do the job. + (when (and append (file-exists-p filename)) + (copy-file filename tmpfile 'ok)) + + ;; We say `no-message' here because we don't want the visited + ;; file modtime data to be clobbered from the temp file. We + ;; call `set-visited-file-modtime' ourselves later on. We + ;; must ensure that `file-coding-system-alist' matches + ;; `tmpfile'. + (let ((file-coding-system-alist + (tramp-find-file-name-coding-system-alist filename tmpfile)) + create-lockfiles) + (condition-case err + (write-region start end tmpfile append 'no-message) + ((error quit) + (setq tramp-temp-buffer-file-name nil) + (delete-file tmpfile) + (signal (car err) (cdr err)))) + + ;; Now, `last-coding-system-used' has the right value. + ;; Remember it. + (setq coding-system-used last-coding-system-used)) + + ;; The permissions of the temporary file should be set. If + ;; FILENAME does not exist (eq modes nil) it has been renamed + ;; to the backup file. This case `save-buffer' handles + ;; permissions. Ensure that it is still readable. + (when modes + (set-file-modes tmpfile (logior (or modes 0) #o0400))) + + ;; This is a bit lengthy due to the different methods possible + ;; for file transfer. First, we check whether the method uses + ;; an scp program. If so, we call it. Otherwise, both + ;; encoding and decoding command must be specified. However, + ;; if the method _also_ specifies an encoding function, then + ;; that is used for encoding the contents of the tmp file. + (let* ((size (file-attribute-size (file-attributes tmpfile))) + (rem-dec (tramp-get-inline-coding v "remote-decoding" size)) + (loc-enc (tramp-get-inline-coding v "local-encoding" size))) + (cond + ;; `copy-file' handles direct copy and out-of-band methods. + ((or (tramp-local-host-p v) + (tramp-method-out-of-band-p v size)) + (if (and (not (stringp start)) + (= (or end (point-max)) (point-max)) + (= (or start (point-min)) (point-min)) + (tramp-get-method-parameter + v 'tramp-copy-keep-tmpfile)) + (progn + (setq tramp-temp-buffer-file-name tmpfile) + (condition-case err + ;; We keep the local file for performance + ;; reasons, useful for "rsync". + (copy-file tmpfile filename t) + ((error quit) + (setq tramp-temp-buffer-file-name nil) + (delete-file tmpfile) + (signal (car err) (cdr err))))) + (setq tramp-temp-buffer-file-name nil) + ;; Don't rename, in order to keep context in SELinux. (unwind-protect - (with-temp-buffer - (set-buffer-multibyte nil) - ;; Use encoding function or command. - (with-tramp-progress-reporter - v 3 (format-message - "Encoding local file `%s' using `%s'" - tmpfile loc-enc) - (if (functionp loc-enc) - ;; The following `let' is a workaround for - ;; the base64.el that comes with pgnus-0.84. - ;; If both of the following conditions are - ;; satisfied, it tries to write to a local - ;; file in default-directory, but at this - ;; point, default-directory is remote. - ;; (`call-process-region' can't write to - ;; remote files, it seems.) The file in - ;; question is a tmp file anyway. - (let ((coding-system-for-read 'binary) - (default-directory - tramp-compat-temporary-file-directory)) - (insert-file-contents-literally tmpfile) - (funcall loc-enc (point-min) (point-max))) - - (unless (zerop (tramp-call-local-coding-command - loc-enc tmpfile t)) - (tramp-error - v 'file-error - (concat "Cannot write to `%s', " - "local encoding command `%s' failed") - filename loc-enc)))) - - ;; Send buffer into remote decoding command which - ;; writes to remote file. Because this happens on - ;; the remote host, we cannot use the function. - (with-tramp-progress-reporter - v 3 (format-message - "Decoding remote file `%s' using `%s'" - filename rem-dec) - (goto-char (point-max)) - (unless (bolp) (newline)) - (tramp-send-command - v - (format - (concat rem-dec " <<'%s'\n%s%s") - (tramp-shell-quote-argument localname) - tramp-end-of-heredoc - (buffer-string) - tramp-end-of-heredoc)) - (tramp-barf-unless-okay - v nil - "Couldn't write region to `%s', decode using `%s' failed" - filename rem-dec) - ;; When `file-precious-flag' is set, the region is - ;; written to a temporary file. Check that the - ;; checksum is equal to that from the local tmpfile. - (when file-precious-flag - (erase-buffer) - (and - ;; cksum runs locally, if possible. - (zerop (tramp-call-process v "cksum" tmpfile t)) - ;; cksum runs remotely. - (tramp-send-command-and-check - v - (format - "cksum <%s" (tramp-shell-quote-argument localname))) - ;; ... they are different. - (not - (string-equal - (buffer-string) - (tramp-get-buffer-string (tramp-get-buffer v)))) - (tramp-error - v 'file-error - (concat "Couldn't write region to `%s'," - " decode using `%s' failed") - filename rem-dec))))) - - ;; Save exit. - (delete-file tmpfile))) - - ;; That's not expected. - (t - (tramp-error - v 'file-error - (concat "Method `%s' should specify both encoding and " - "decoding command or an scp program") - method)))) - - ;; Make `last-coding-system-used' have the right value. - (when coding-system-used - (setq last-coding-system-used coding-system-used)))) - - (tramp-flush-file-properties v localname) + (copy-file tmpfile filename t) + (delete-file tmpfile)))) + + ;; Use inline file transfer. + (rem-dec + ;; Encode tmpfile. + (unwind-protect + (with-temp-buffer + (set-buffer-multibyte nil) + ;; Use encoding function or command. + (with-tramp-progress-reporter + v 3 (format-message + "Encoding local file `%s' using `%s'" + tmpfile loc-enc) + (if (functionp loc-enc) + ;; The following `let' is a workaround for the + ;; base64.el that comes with pgnus-0.84. If + ;; both of the following conditions are + ;; satisfied, it tries to write to a local + ;; file in default-directory, but at this + ;; point, default-directory is remote. + ;; (`call-process-region' can't write to + ;; remote files, it seems.) The file in + ;; question is a tmp file anyway. + (let ((coding-system-for-read 'binary) + (default-directory + tramp-compat-temporary-file-directory)) + (insert-file-contents-literally tmpfile) + (funcall loc-enc (point-min) (point-max))) + + (unless (zerop (tramp-call-local-coding-command + loc-enc tmpfile t)) + (tramp-error + v 'file-error + (concat "Cannot write to `%s', " + "local encoding command `%s' failed") + filename loc-enc)))) + + ;; Send buffer into remote decoding command which + ;; writes to remote file. Because this happens on + ;; the remote host, we cannot use the function. + (with-tramp-progress-reporter + v 3 (format-message + "Decoding remote file `%s' using `%s'" + filename rem-dec) + (goto-char (point-max)) + (unless (bolp) (newline)) + (tramp-send-command + v + (format + (concat rem-dec " <<'%s'\n%s%s") + (tramp-shell-quote-argument localname) + tramp-end-of-heredoc + (buffer-string) + tramp-end-of-heredoc)) + (tramp-barf-unless-okay + v nil + "Couldn't write region to `%s', decode using `%s' failed" + filename rem-dec) + ;; When `file-precious-flag' is set, the region is + ;; written to a temporary file. Check that the + ;; checksum is equal to that from the local tmpfile. + (when file-precious-flag + (erase-buffer) + (and + ;; cksum runs locally, if possible. + (zerop (tramp-call-process v "cksum" tmpfile t)) + ;; cksum runs remotely. + (tramp-send-command-and-check + v + (format + "cksum <%s" + (tramp-shell-quote-argument localname))) + ;; ... they are different. + (not + (string-equal + (buffer-string) + (tramp-get-buffer-string (tramp-get-buffer v)))) + (tramp-error + v 'file-error + "Couldn't write region to `%s', decode using `%s' failed" + filename rem-dec))))) + + ;; Save exit. + (delete-file tmpfile))) + + ;; That's not expected. + (t + (tramp-error + v 'file-error + (concat "Method `%s' should specify both encoding and " + "decoding command or an scp program") + method)))) - ;; We must protect `last-coding-system-used', now we have set it - ;; to its correct value. - (let (last-coding-system-used (need-chown t)) - ;; Set file modification time. - (when (or (eq visit t) (stringp visit)) - (let ((file-attr (file-attributes filename 'integer))) - (set-visited-file-modtime - ;; We must pass modtime explicitly, because FILENAME can - ;; be different from (buffer-file-name), f.e. if - ;; `file-precious-flag' is set. - (or (file-attribute-modification-time file-attr) - (current-time))) - (when (and (= (file-attribute-user-id file-attr) uid) - (= (file-attribute-group-id file-attr) gid)) - (setq need-chown nil)))) - - ;; Set the ownership. - (when need-chown - (tramp-set-file-uid-gid filename uid gid)) - - ;; Unlock file. - (when file-locked - ;; `unlock-file' exists since Emacs 28.1. - (tramp-compat-funcall 'unlock-file lockname)) - - (when (and (null noninteractive) - (or (eq visit t) (string-or-null-p visit))) - (tramp-message v 0 "Wrote %s" filename)) - (run-hooks 'tramp-handle-write-region-hook))))) + ;; Make `last-coding-system-used' have the right value. + (when coding-system-used + (setq last-coding-system-used coding-system-used)))))) (defvar tramp-vc-registered-file-names nil "List used to collect file names, which are checked during `vc-registered'.") @@ -4036,9 +3988,6 @@ Returns the exit code of the `test' program." switch (tramp-shell-quote-argument localname))))) -(defconst tramp-sunos-unames (regexp-opt '("SunOS 5.10" "SunOS 5.11")) - "Regexp to determine remote SunOS.") - (defun tramp-find-executable (vec progname dirlist &optional ignore-tilde ignore-path) "Search for PROGNAME in $PATH and all directories mentioned in DIRLIST. diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 4af5a4204f2..968c1daccbf 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -1617,28 +1617,8 @@ VEC or USER, or if there is no home directory, return nil." (defun tramp-smb-handle-write-region (start end filename &optional append visit lockname mustbenew) "Like `write-region' for Tramp files." - (setq filename (expand-file-name filename) - lockname (file-truename (or lockname filename))) - (with-parsed-tramp-file-name filename nil - (when (and mustbenew (file-exists-p filename) - (or (eq mustbenew 'excl) - (not - (y-or-n-p - (format "File %s exists; overwrite anyway?" filename))))) - (tramp-error v 'file-already-exists filename)) - - (let ((file-locked (eq (file-locked-p lockname) t)) - (curbuf (current-buffer)) - (tmpfile (tramp-compat-make-temp-file filename))) - - ;; Lock file. - (when (and (not (auto-save-file-name-p (file-name-nondirectory filename))) - (file-remote-p lockname) - (not file-locked)) - (setq file-locked t) - ;; `lock-file' exists since Emacs 28.1. - (tramp-compat-funcall 'lock-file lockname)) - + (tramp-skeleton-write-region start end filename append visit lockname mustbenew + (let ((tmpfile (tramp-compat-make-temp-file filename))) (when (and append (file-exists-p filename)) (copy-file filename tmpfile 'ok)) ;; We say `no-message' here because we don't want the visited file @@ -1654,33 +1634,7 @@ VEC or USER, or if there is no home directory, return nil." v (format "put %s \"%s\"" tmpfile (tramp-smb-get-localname v))) (tramp-error v 'file-error "Cannot write `%s'" filename)) - (delete-file tmpfile))) - - ;; We must also flush the cache of the directory, because - ;; `file-attributes' reads the values from there. - (tramp-flush-file-properties v localname) - - (unless (equal curbuf (current-buffer)) - (tramp-error - v 'file-error - "Buffer has changed from `%s' to `%s'" curbuf (current-buffer))) - - ;; 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. - (tramp-compat-funcall 'unlock-file lockname)) - - ;; The end. - (when (and (null noninteractive) - (or (eq visit t) (string-or-null-p visit))) - (tramp-message v 0 "Wrote %s" filename)) - (run-hooks 'tramp-handle-write-region-hook)))) + (delete-file tmpfile)))))) ;; Internal file name functions. diff --git a/lisp/net/tramp-sshfs.el b/lisp/net/tramp-sshfs.el index 02c0da3f184..61bf165f308 100644 --- a/lisp/net/tramp-sshfs.el +++ b/lisp/net/tramp-sshfs.el @@ -373,47 +373,10 @@ arguments to pass to the OPERATION." (defun tramp-sshfs-handle-write-region (start end filename &optional append visit lockname mustbenew) "Like `write-region' for Tramp files." - (setq filename (expand-file-name filename) - lockname (file-truename (or lockname filename))) - (with-parsed-tramp-file-name filename nil - (when (and mustbenew (file-exists-p filename) - (or (eq mustbenew 'excl) - (not - (y-or-n-p - (format "File %s exists; overwrite anyway?" filename))))) - (tramp-error v 'file-already-exists filename)) - - (let ((file-locked (eq (file-locked-p lockname) t))) - - ;; Lock file. - (when (and (not (auto-save-file-name-p (file-name-nondirectory filename))) - (file-remote-p lockname) - (not file-locked)) - (setq file-locked t) - ;; `lock-file' exists since Emacs 28.1. - (tramp-compat-funcall 'lock-file lockname)) - - (let (create-lockfiles) - (write-region - 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. - (tramp-compat-funcall 'unlock-file lockname)) - - ;; The end. - (when (and (null noninteractive) - (or (eq visit t) (string-or-null-p visit))) - (tramp-message v 0 "Wrote %s" filename)) - (run-hooks 'tramp-handle-write-region-hook)))) + (tramp-skeleton-write-region start end filename append visit lockname mustbenew + (let (create-lockfiles) + (write-region + start end (tramp-fuse-local-file-name filename) append 'nomessage)))) ;; File name conversions. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 1f429edf4f8..b889f1f8848 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -238,7 +238,7 @@ pair of the form (KEY VALUE). The following KEYs are defined: unchanged after expansion (i.e. no host, no user or no port were specified), that sublist is not used. For e.g. - '((\"-a\" \"-b\") (\"-l\" \"%u\")) + \\='((\"-a\" \"-b\") (\"-l\" \"%u\")) that means that (\"-l\" \"%u\") is used only if the user was specified, and it is thus effectively optional. @@ -2183,6 +2183,11 @@ FMT-STRING and ARGUMENTS." (put #'tramp-error 'tramp-suppress-trace t) +(defvar tramp-error-show-message-timeout 30 + "Time to show the Tramp buffer in case of an error. +If it is bound to nil, the buffer is not shown. This is used in +tramp-tests.el.") + (defsubst tramp-error-with-buffer (buf vec-or-proc signal fmt-string &rest arguments) "Emit an error, and show BUF. @@ -2200,6 +2205,7 @@ an input event arrives. The other arguments are passed to `tramp-error'." (apply #'tramp-error vec-or-proc signal fmt-string arguments) ;; Save exit. (when (and buf + (natnump tramp-error-show-message-timeout) (not (zerop tramp-verbose)) ;; Do not show when flagged from outside. (not non-essential) @@ -2213,7 +2219,7 @@ an input event arrives. The other arguments are passed to `tramp-error'." ;; Show buffer. (pop-to-buffer buf) (discard-input) - (sit-for 30))) + (sit-for tramp-error-show-message-timeout))) ;; Reset timestamp. It would be wrong after waiting for a while. (when (tramp-file-name-equal-p vec (car tramp-current-connection)) (setcdr tramp-current-connection (current-time))))))) @@ -2226,7 +2232,8 @@ an input event arrives. The other arguments are passed to `tramp-error'." (unwind-protect (apply #'tramp-error vec-or-proc 'user-error fmt-string arguments) ;; Save exit. - (when (and (not (zerop tramp-verbose)) + (when (and (natnump tramp-error-show-message-timeout) + (not (zerop tramp-verbose)) ;; Do not show when flagged from outside. (not non-essential) ;; Show only when Emacs has started already. @@ -2236,7 +2243,7 @@ an input event arrives. The other arguments are passed to `tramp-error'." ;; `tramp-error' does not show messages. So we must do it ourselves. (apply #'message fmt-string arguments) (discard-input) - (sit-for 30) + (sit-for tramp-error-show-message-timeout) ;; Reset timestamp. It would be wrong after waiting for a while. (when (tramp-file-name-equal-p vec-or-proc (car tramp-current-connection)) @@ -3346,6 +3353,121 @@ User is always nil." (forward-line 1) result)) +;;; Skeleton macros for file name handler functions. + +(defmacro tramp-skeleton-delete-directory (directory recursive trash &rest body) + "Skeleton for `tramp-*-handle-delete-directory'. +BODY is the backend specific code." + (declare (indent 3) (debug t)) + `(with-parsed-tramp-file-name (expand-file-name ,directory) nil + (if (and delete-by-moving-to-trash ,trash) + ;; Move non-empty dir to trash only if recursive deletion was + ;; requested. + (if (not (or ,recursive (tramp-compat-directory-empty-p ,directory))) + (tramp-error + v 'file-error "Directory is not empty, not moving to trash") + (move-file-to-trash ,directory)) + ,@body) + (tramp-flush-directory-properties v localname))) + +(put #'tramp-skeleton-delete-directory 'tramp-suppress-trace t) + +(defmacro tramp-skeleton-write-region + (start end filename append visit lockname mustbenew &rest body) + "Skeleton for `tramp-*-handle-write-region'. +BODY is the backend specific code." + (declare (indent 7) (debug t)) + `(with-parsed-tramp-file-name (expand-file-name ,filename) nil + (setq ,filename (expand-file-name ,filename) + ,lockname (file-truename (or ,lockname ,filename))) + ;; Sometimes, there is another file name handler responsible for + ;; VISIT, for example `jka-compr-handler'. We must respect this. + ;; See Bug#55166. + (let ((handler (and (stringp ,visit) + (let ((inhibit-file-name-handlers + (cons 'tramp-file-name-handler + inhibit-file-name-handlers)) + (inhibit-file-name-operation 'write-region)) + (find-file-name-handler ,visit 'write-region))))) + (if handler + (progn + (tramp-message + v 5 "Calling handler `%s' for visiting `%s'" handler ,visit) + (funcall + handler 'write-region + ,start ,end ,filename ,append ,visit ,lockname ,mustbenew)) + + (when (and ,mustbenew (file-exists-p ,filename) + (or (eq ,mustbenew 'excl) + (not + (y-or-n-p + (format + "File %s exists; overwrite anyway?" ,filename))))) + (tramp-error v 'file-already-exists ,filename)) + + (let ((file-locked (eq (file-locked-p ,lockname) t)) + (uid (or (file-attribute-user-id + (file-attributes ,filename 'integer)) + (tramp-get-remote-uid v 'integer))) + (gid (or (file-attribute-group-id + (file-attributes ,filename 'integer)) + (tramp-get-remote-gid v 'integer))) + (curbuf (current-buffer))) + + ;; Lock file. + (when (and (not (auto-save-file-name-p + (file-name-nondirectory ,filename))) + (file-remote-p ,lockname) + (not file-locked)) + (setq file-locked t) + ;; `lock-file' exists since Emacs 28.1. + (tramp-compat-funcall 'lock-file ,lockname)) + + ;; The body. + ,@body + + ;; We must protect `last-coding-system-used', now we have + ;; set it to its correct value. + (let (last-coding-system-used (need-chown t)) + ;; Set file modification time. + (when (or (eq ,visit t) (stringp ,visit)) + (let ((file-attr (file-attributes ,filename 'integer))) + (set-visited-file-modtime + ;; We must pass modtime explicitly, because FILENAME + ;; can be different from (buffer-file-name), f.e. if + ;; `file-precious-flag' is set. + (or (file-attribute-modification-time file-attr) + (current-time))) + (when (and (= (file-attribute-user-id file-attr) uid) + (= (file-attribute-group-id file-attr) gid)) + (setq need-chown nil)))) + + ;; Set the ownership. + (when need-chown + (tramp-set-file-uid-gid ,filename uid gid))) + + ;; We must also flush the cache of the directory, because + ;; `file-attributes' reads the values from there. + (tramp-flush-file-properties v localname) + + ;; Unlock file. + (when file-locked + ;; `unlock-file' exists since Emacs 28.1. + (tramp-compat-funcall 'unlock-file ,lockname)) + + ;; Sanity check. + (unless (equal curbuf (current-buffer)) + (tramp-error + v 'file-error + "Buffer has changed from `%s' to `%s'" curbuf (current-buffer))) + + (when (and (null noninteractive) + (or (eq ,visit t) (string-or-null-p ,visit))) + (tramp-message v 0 "Wrote %s" ,filename)) + (run-hooks 'tramp-handle-write-region-hook)))))) + +(put #'tramp-skeleton-write-region 'tramp-suppress-trace t) + ;;; Common file name handler functions for different backends: (defvar tramp-handle-file-local-copy-hook nil @@ -4820,33 +4942,10 @@ of." (defun tramp-handle-write-region (start end filename &optional append visit lockname mustbenew) "Like `write-region' for Tramp files." - (setq filename (expand-file-name filename) - lockname (file-truename (or lockname filename))) - (with-parsed-tramp-file-name filename nil - (when (and mustbenew (file-exists-p filename) - (or (eq mustbenew 'excl) - (not - (y-or-n-p - (format "File %s exists; overwrite anyway?" filename))))) - (tramp-error v 'file-already-exists filename)) - - (let ((file-locked (eq (file-locked-p lockname) t)) - (tmpfile (tramp-compat-make-temp-file filename)) + (tramp-skeleton-write-region start end filename append visit lockname mustbenew + (let ((tmpfile (tramp-compat-make-temp-file filename)) (modes (tramp-default-file-modes - filename (and (eq mustbenew 'excl) 'nofollow))) - (uid (or (file-attribute-user-id (file-attributes filename 'integer)) - (tramp-get-remote-uid v 'integer))) - (gid (or (file-attribute-group-id (file-attributes filename 'integer)) - (tramp-get-remote-gid v 'integer)))) - - ;; Lock file. - (when (and (not (auto-save-file-name-p (file-name-nondirectory filename))) - (file-remote-p lockname) - (not file-locked)) - (setq file-locked t) - ;; `lock-file' exists since Emacs 28.1. - (tramp-compat-funcall 'lock-file lockname)) - + filename (and (eq mustbenew 'excl) 'nofollow)))) (when (and append (file-exists-p filename)) (copy-file filename tmpfile 'ok)) ;; The permissions of the temporary file should be set. If @@ -4865,29 +4964,7 @@ of." (error (delete-file tmpfile) (tramp-error - v 'file-error "Couldn't write region to `%s'" filename))) - - (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)))) - - ;; Set the ownership. - (tramp-set-file-uid-gid filename uid gid) - - ;; Unlock file. - (when file-locked - ;; `unlock-file' exists since Emacs 28.1. - (tramp-compat-funcall 'unlock-file lockname)) - - ;; The end. - (when (and (null noninteractive) - (or (eq visit t) (string-or-null-p visit))) - (tramp-message v 0 "Wrote %s" filename)) - (run-hooks 'tramp-handle-write-region-hook)))) + v 'file-error "Couldn't write region to `%s'" filename)))))) ;; This is used in tramp-sh.el and tramp-sudoedit.el. (defconst tramp-stat-marker "/////" @@ -5915,14 +5992,15 @@ verbosity of 6." "Return t if system process PROCESS-NAME is running for `user-login-name'." (when (stringp process-name) (catch 'result - (dolist (pid (list-system-processes)) - (when-let ((attributes (process-attributes pid)) - (comm (cdr (assoc 'comm attributes)))) - (and (string-equal (cdr (assoc 'user attributes)) (user-login-name)) - ;; The returned command name could be truncated to 15 - ;; characters. Therefore, we cannot check for `string-equal'. - (string-prefix-p comm process-name) - (throw 'result t))))))) + (let ((default-directory temporary-file-directory)) + (dolist (pid (list-system-processes)) + (when-let ((attributes (process-attributes pid)) + (comm (cdr (assoc 'comm attributes)))) + (and (string-equal (cdr (assoc 'user attributes)) (user-login-name)) + ;; The returned command name could be truncated to 15 + ;; characters. Therefore, we cannot check for `string-equal'. + (string-prefix-p comm process-name) + (throw 'result t)))))))) ;; When calling "emacs -Q", `auth-source-search' won't be called. If ;; you want to debug exactly this case, call "emacs -Q --eval '(setq @@ -6168,23 +6246,6 @@ If VEC is `tramp-null-hop', return local null device." (let ((default-directory (tramp-make-tramp-file-name vec))) (tramp-compat-null-device))))) -(defmacro tramp-skeleton-delete-directory (directory recursive trash &rest body) - "Skeleton for `tramp-*-handle-delete-directory'. -BODY is the backend specific code." - (declare (indent 3) (debug t)) - `(with-parsed-tramp-file-name (expand-file-name ,directory) nil - (if (and delete-by-moving-to-trash ,trash) - ;; Move non-empty dir to trash only if recursive deletion was - ;; requested. - (if (not (or ,recursive (tramp-compat-directory-empty-p ,directory))) - (tramp-error - v 'file-error "Directory is not empty, not moving to trash") - (move-file-to-trash ,directory)) - ,@body) - (tramp-flush-directory-properties v localname))) - -(put #'tramp-skeleton-delete-directory 'tramp-suppress-trace t) - ;; Checklist for `tramp-unload-hook' ;; - Unload all `tramp-*' packages ;; - Reset `file-name-handler-alist' diff --git a/lisp/obsolete/mouse-sel.el b/lisp/obsolete/mouse-sel.el index a9d6bfee604..3eacac65fba 100644 --- a/lisp/obsolete/mouse-sel.el +++ b/lisp/obsolete/mouse-sel.el @@ -438,7 +438,7 @@ Click sets point & mark to click position. Dragging extends region/selection. Multi-clicking selects word/lines/paragraphs, as determined by -'mouse-sel-determine-selection-thing. +`mouse-sel-determine-selection-thing'. Clicking mouse-2 while selecting copies selected text to the kill-ring. Clicking mouse-1 or mouse-3 kills the selected text. @@ -459,7 +459,7 @@ Click sets the start of the secondary selection to click position. Dragging extends the secondary selection. Multi-clicking selects word/lines/paragraphs, as determined by -'mouse-sel-determine-selection-thing. +`mouse-sel-determine-selection-thing'. Clicking mouse-2 while selecting copies selected text to the kill-ring. Clicking mouse-1 or mouse-3 kills the selected text. diff --git a/lisp/org/ob-core.el b/lisp/org/ob-core.el index 23ef162a7f3..04af84d2e44 100644 --- a/lisp/org/ob-core.el +++ b/lisp/org/ob-core.el @@ -480,7 +480,7 @@ value. The value can either be a string or a closure that evaluates to a string. The closure is evaluated when the source block is being evaluated (e.g. during execution or export), with point at the source block. It is not possible to use an -arbitrary function symbol (e.g. 'some-func), since org uses +arbitrary function symbol (e.g. `some-func'), since org uses lexical binding. To achieve the same functionality, call the function within a closure (e.g. (lambda () (some-func))). diff --git a/lisp/org/ob-julia.el b/lisp/org/ob-julia.el index abddca36134..50a44bcf448 100644 --- a/lisp/org/ob-julia.el +++ b/lisp/org/ob-julia.el @@ -250,8 +250,8 @@ end") (defun org-babel-julia-evaluate-external-process (body result-type result-params column-names-p) "Evaluate BODY in external julia process. -If RESULT-TYPE equals 'output then return standard output as a -string. If RESULT-TYPE equals 'value then return the value of the +If RESULT-TYPE equals `output' then return standard output as a +string. If RESULT-TYPE equals `value' then return the value of the last statement in BODY, as elisp." (cl-case result-type (value @@ -274,8 +274,8 @@ last statement in BODY, as elisp." (defun org-babel-julia-evaluate-session (session body result-type result-params column-names-p) "Evaluate BODY in SESSION. -If RESULT-TYPE equals 'output then return standard output as a -string. If RESULT-TYPE equals 'value then return the value of the +If RESULT-TYPE equals `output' then return standard output as a +string. If RESULT-TYPE equals `value' then return the value of the last statement in BODY, as elisp." (cl-case result-type (value diff --git a/lisp/org/ob-lua.el b/lisp/org/ob-lua.el index 48de0dbad06..b6e78fb7fd8 100644 --- a/lisp/org/ob-lua.el +++ b/lisp/org/ob-lua.el @@ -395,7 +395,7 @@ fd:close()" (org-babel-lua-table-or-string results))))) (defun org-babel-lua-read-string (string) - "Strip 's from around Lua string." + "Strip \\=' characters from around Lua string." (org-unbracket-string "'" "'" string)) (provide 'ob-lua) diff --git a/lisp/org/ob-table.el b/lisp/org/ob-table.el index 2f092998d8b..f6729e0ece7 100644 --- a/lisp/org/ob-table.el +++ b/lisp/org/ob-table.el @@ -84,7 +84,7 @@ is the equivalent of the following source code block: #+end_src NOTE: The quotation marks around the function name, -'source-block', are optional. +`source-block', are optional. NOTE: By default, string variable names are interpreted as references to source-code blocks, to force interpretation of a diff --git a/lisp/org/oc-basic.el b/lisp/org/oc-basic.el index 81b7e4471fd..775690f1767 100644 --- a/lisp/org/oc-basic.el +++ b/lisp/org/oc-basic.el @@ -233,6 +233,8 @@ Return a hash table with citation references as keys and fields alist as values. entries))) entries)) +(defvar org-cite-basic--file-id-cache nil + "Hash table linking files to their hash.") (defun org-cite-basic--parse-bibliography (&optional info) "List all entries available in the buffer. @@ -245,14 +247,19 @@ table where keys are references and values are association lists between fields, as symbols, and values as strings or nil. Optional argument INFO is the export state, as a property list." + (unless (hash-table-p org-cite-basic--file-id-cache) + (setq org-cite-basic--file-id-cache (make-hash-table :test #'equal))) (if (plist-member info :cite-basic/bibliography) (plist-get info :cite-basic/bibliography) (let ((results nil)) (dolist (file (org-cite-list-bibliography-files)) (when (file-readable-p file) (with-temp-buffer - (insert-file-contents file) - (let* ((file-id (cons file (org-buffer-hash))) + (when (or (org-file-has-changed-p file) + (not (gethash file org-cite-basic--file-id-cache))) + (insert-file-contents file) + (puthash file (org-buffer-hash) org-cite-basic--file-id-cache)) + (let* ((file-id (cons file (gethash file org-cite-basic--file-id-cache))) (entries (or (cdr (assoc file-id org-cite-basic--bibliography-cache)) (let ((table @@ -727,19 +734,24 @@ Return nil if there are no bibliography files or no entries." (t (clrhash org-cite-basic--completion-cache) (dolist (key (org-cite-basic--all-keys)) - (let ((completion - (concat - (let ((author (org-cite-basic--get-field 'author key nil t))) - (if author - (truncate-string-to-width - (replace-regexp-in-string " and " "; " author) - org-cite-basic-author-column-end nil ?\s) - (make-string org-cite-basic-author-column-end ?\s))) - org-cite-basic-column-separator - (let ((date (org-cite-basic--get-year key nil 'no-suffix))) - (format "%4s" (or date ""))) - org-cite-basic-column-separator - (org-cite-basic--get-field 'title key nil t)))) + (let* ((entry (org-cite-basic--get-entry + key + ;; Supply pre-calculated bibliography to avoid + ;; performance degradation. + (list :cite-basic/bibliography entries))) + (completion + (concat + (let ((author (org-cite-basic--get-field 'author entry nil 'raw))) + (if author + (truncate-string-to-width + (replace-regexp-in-string " and " "; " author) + org-cite-basic-author-column-end nil ?\s) + (make-string org-cite-basic-author-column-end ?\s))) + org-cite-basic-column-separator + (let ((date (org-cite-basic--get-year entry nil 'no-suffix))) + (format "%4s" (or date ""))) + org-cite-basic-column-separator + (org-cite-basic--get-field 'title entry nil t)))) (puthash completion key org-cite-basic--completion-cache))) (unless (map-empty-p org-cite-basic--completion-cache) ;no key (puthash entries t org-cite-basic--completion-cache) diff --git a/lisp/org/oc-biblatex.el b/lisp/org/oc-biblatex.el index 3cc157ec937..174725b4244 100644 --- a/lisp/org/oc-biblatex.el +++ b/lisp/org/oc-biblatex.el @@ -164,12 +164,7 @@ INFO is the export state, as a property list." (mapconcat (lambda (r) (org-cite-biblatex--atomic-arguments (list r) info)) (org-cite-get-references citation) - "") - ;; According to BibLaTeX manual, left braces or brackets - ;; following a multicite command could be parsed as other - ;; arguments. So we stop any further parsing by inserting - ;; a \relax unconditionally. - "\\relax"))) + "")))) (defun org-cite-biblatex--command (citation info base &optional multi no-opt) "Return biblatex command using BASE name for CITATION object. diff --git a/lisp/org/org-agenda.el b/lisp/org/org-agenda.el index ae0058e037e..dfd5d829db2 100644 --- a/lisp/org/org-agenda.el +++ b/lisp/org/org-agenda.el @@ -4124,7 +4124,7 @@ dimming them." ;FIXME: The arg isn't used, actually! If the header at `org-hd-marker' is blocked according to `org-entry-blocked-p', then if `org-agenda-dim-blocked-tasks' is -'invisible and the header is not blocked by checkboxes, set the +`invisible' and the header is not blocked by checkboxes, set the text property `org-todo-blocked' to `invisible', otherwise set it to t." (when (get-text-property 0 'todo-state entry) @@ -4859,7 +4859,7 @@ Press `\\[org-agenda-manipulate-query-add]', \ ;;;###autoload (defun org-todo-list (&optional arg) - "Show all (not done) TODO entries from all agenda file in a single list. + "Show all (not done) TODO entries from all agenda files in a single list. The prefix arg can be used to select a specific TODO keyword and limit the list to these. When using `\\[universal-argument]', you will be prompted for a keyword. A numeric prefix directly selects the Nth keyword in @@ -5732,7 +5732,7 @@ displayed in agenda view." (org-before-first-heading-p) (and org-agenda-include-inactive-timestamps (org-at-clock-log-p)) - (not (eq 'timestamp (org-element-type (org-element-context))))) + (not (org-at-timestamp-p 'agenda))) (throw :skip nil)) (org-agenda-skip)) (let* ((pos (match-beginning 0)) @@ -7180,12 +7180,13 @@ The optional argument TYPE tells the agenda type." (concat (substring x 0 (match-end 1)) (unless (string= org-agenda-todo-keyword-format "") - (format org-agenda-todo-keyword-format - (match-string 2 x))) - ;; Remove `display' property as the icon could leak - ;; on the white space. - (org-add-props " " (org-plist-delete (text-properties-at 0 x) - 'display)) + (format org-agenda-todo-keyword-format + (match-string 2 x))) + (unless (string= org-agenda-todo-keyword-format "") + ;; Remove `display' property as the icon could leak + ;; on the white space. + (org-add-props " " (org-plist-delete (text-properties-at 0 x) + 'display))) (substring x (match-end 3))))))) x))) @@ -7398,7 +7399,7 @@ Argument ARG is the prefix argument." When in a restricted subtree, remove it. The restriction will span over the entire file if TYPE is `file', -or if type is '(4), or if the cursor is before the first headline +or if type is \\='(4), or if the cursor is before the first headline in the file. Otherwise, only apply the restriction to the current subtree." (interactive "P") diff --git a/lisp/org/org-compat.el b/lisp/org/org-compat.el index 819ce74d93d..3e394fbab1c 100644 --- a/lisp/org/org-compat.el +++ b/lisp/org/org-compat.el @@ -39,7 +39,7 @@ (declare-function org-calendar-goto-agenda "org-agenda" ()) (declare-function org-align-tags "org" (&optional all)) (declare-function org-at-heading-p "org" (&optional ignored)) -(declare-function org-at-table.el-p "org" ()) +(declare-function org-at-table.el-p "org-table" ()) (declare-function org-element-at-point "org-element" ()) (declare-function org-element-context "org-element" (&optional element)) (declare-function org-element-lineage "org-element" (blob &optional types with-self)) @@ -72,6 +72,35 @@ (defvar org-table1-hline-regexp) +;;; Emacs < 29 compatibility + +(defvar org-file-has-changed-p--hash-table (make-hash-table :test #'equal) + "Internal variable used by `org-file-has-changed-p'.") + +(if (fboundp 'file-has-changed-p) + (defalias 'org-file-has-changed-p #'file-has-changed-p) + (defun org-file-has-changed-p (file &optional tag) + "Return non-nil if FILE has changed. +The size and modification time of FILE are compared to the size +and modification time of the same FILE during a previous +invocation of `org-file-has-changed-p'. Thus, the first invocation +of `org-file-has-changed-p' always returns non-nil when FILE exists. +The optional argument TAG, which must be a symbol, can be used to +limit the comparison to invocations with identical tags; it can be +the symbol of the calling function, for example." + (let* ((file (directory-file-name (expand-file-name file))) + (remote-file-name-inhibit-cache t) + (fileattr (file-attributes file 'integer)) + (attr (and fileattr + (cons (file-attribute-size fileattr) + (file-attribute-modification-time fileattr)))) + (sym (concat (symbol-name tag) "@" file)) + (cachedattr (gethash sym org-file-has-changed-p--hash-table))) + (when (not (equal attr cachedattr)) + (puthash sym attr org-file-has-changed-p--hash-table))))) + + + ;;; Emacs < 28.1 compatibility (if (fboundp 'directory-empty-p) @@ -209,7 +238,7 @@ This is a floating point number if the size is too large for an integer." (if (fboundp 'string-collate-lessp) (defalias 'org-string-collate-lessp 'string-collate-lessp) - (defun org-string-collate-lessp (s1 s2 &rest _) + (defun org-string-collate-lessp (s1 s2 &optional _ _) "Return non-nil if STRING1 is less than STRING2 in lexicographic order. Case is significant." (string< s1 s2))) diff --git a/lisp/org/org-faces.el b/lisp/org/org-faces.el index 1db36bc72ba..d96898372f9 100644 --- a/lisp/org/org-faces.el +++ b/lisp/org/org-faces.el @@ -38,8 +38,7 @@ :group 'org-faces) (defface org-hide - '((default :inherit fixed-pitch) - (((background light)) (:foreground "white")) + '((((background light)) (:foreground "white")) (((background dark)) (:foreground "black"))) "Face used to hide leading stars in headlines. The foreground color of this face should be equal to the background @@ -202,8 +201,7 @@ set the properties in the `org-column' face. For example, set :group 'org-faces) (defface org-date - '((default :inherit fixed-pitch) - (((class color) (background light)) (:foreground "Purple" :underline t)) + '((((class color) (background light)) (:foreground "Purple" :underline t)) (((class color) (background dark)) (:foreground "Cyan" :underline t)) (t (:underline t))) "Face for date/time stamps." @@ -379,8 +377,7 @@ changes." (sexp :tag "Face"))))) (defface org-table ;Copied from `font-lock-function-name-face' - '((default :inherit fixed-pitch) - (((class color) (min-colors 88) (background light)) (:foreground "Blue1")) + '((((class color) (min-colors 88) (background light)) (:foreground "Blue1")) (((class color) (min-colors 88) (background dark)) (:foreground "LightSkyBlue")) (((class color) (min-colors 16) (background light)) (:foreground "Blue")) (((class color) (min-colors 16) (background dark)) (:foreground "LightSkyBlue")) @@ -396,8 +393,7 @@ changes." :group 'org-faces) (defface org-formula - '((default :inherit fixed-pitch) - (((class color) (min-colors 88) (background light)) (:foreground "Firebrick")) + '((((class color) (min-colors 88) (background light)) (:foreground "Firebrick")) (((class color) (min-colors 88) (background dark)) (:foreground "chocolate1")) (((class color) (min-colors 8) (background light)) (:foreground "red")) (((class color) (min-colors 8) (background dark)) (:foreground "red")) @@ -405,12 +401,12 @@ changes." "Face for formulas." :group 'org-faces) -(defface org-code '((t :inherit (fixed-pitch shadow))) +(defface org-code '((t :inherit shadow)) "Face for fixed-width text like code snippets." :group 'org-faces :version "22.1") -(defface org-meta-line '((t :inherit (fixed-pitch font-lock-comment-face))) +(defface org-meta-line '((t :inherit font-lock-comment-face)) "Face for meta lines starting with \"#+\"." :group 'org-faces :version "22.1") @@ -437,7 +433,7 @@ This face applies to the #+TITLE:, #+SUBTITLE:, #+AUTHOR:, #+EMAIL: and #+DATE: keywords." :group 'org-faces) -(defface org-block `((t :inherit (fixed-pitch shadow) +(defface org-block `((t :inherit shadow ,@(and (>= emacs-major-version 27) '(:extend t)))) "Face used for text inside various blocks. @@ -459,7 +455,7 @@ verse and quote blocks are fontified using the `org-verse' and "Face used for the line delimiting the end of source blocks." :group 'org-faces) -(defface org-verbatim '((t (:inherit (fixed-pitch shadow)))) +(defface org-verbatim '((t (:inherit shadow))) "Face for fixed-with text like code snippets." :group 'org-faces :version "22.1") diff --git a/lisp/org/org-macs.el b/lisp/org/org-macs.el index b10725bd526..bb0562dde06 100644 --- a/lisp/org/org-macs.el +++ b/lisp/org/org-macs.el @@ -37,6 +37,7 @@ (declare-function org-mode "org" ()) (declare-function org-show-context "org" (&optional key)) (declare-function org-string-collate-lessp "org-compat" (s1 s2 &optional locale ignore-case)) +(declare-function org-time-convert-to-integer "org-compat" (time)) (defvar org-ts-regexp0) (defvar ffap-url-regexp) @@ -257,15 +258,16 @@ ignored in this case." (defun org-file-newer-than-p (file time) "Non-nil if FILE is newer than TIME. -FILE is a filename, as a string, TIME is a list of integers, as +FILE is a filename, as a string, TIME is a Lisp time value, as returned by, e.g., `current-time'." (and (file-exists-p file) ;; Only compare times up to whole seconds as some file-systems ;; (e.g. HFS+) do not retain any finer granularity. As ;; a consequence, make sure we return non-nil when the two ;; times are equal. - (not (time-less-p (cl-subseq (nth 5 (file-attributes file)) 0 2) - (cl-subseq time 0 2))))) + (not (time-less-p (org-time-convert-to-integer + (nth 5 (file-attributes file))) + (org-time-convert-to-integer time))))) (defun org-compile-file (source process ext &optional err-msg log-buf spec) "Compile a SOURCE file using PROCESS. diff --git a/lisp/org/org-mouse.el b/lisp/org/org-mouse.el index 20c20acc320..a590ff87f24 100644 --- a/lisp/org/org-mouse.el +++ b/lisp/org/org-mouse.el @@ -208,7 +208,7 @@ this function is called. Otherwise, the current major mode menu is used." (interactive "@e \nP") (if (and (= (event-click-count event) 1) (or (not mark-active) - (sit-for (/ double-click-time 1000.0)))) + (sit-for (/ (mouse-double-click-time) 1000.0)))) (progn (select-window (posn-window (event-start event))) (when (not (org-mouse-mark-active)) diff --git a/lisp/org/org-plot.el b/lisp/org/org-plot.el index bf84c99e042..4507fbe7ddc 100644 --- a/lisp/org/org-plot.el +++ b/lisp/org/org-plot.el @@ -280,7 +280,7 @@ When NORMALISE is non-nil, the count is divided by the number of values." collect (cons n (/ (length m) normaliser))))) (defun org--plot/prime-factors (value) - "Return the prime decomposition of VALUE, e.g. for 12, '(3 2 2)." + "Return the prime decomposition of VALUE, e.g. for 12, \\='(3 2 2)." (let ((factors '(1)) (i 1)) (while (/= 1 value) (setq i (1+ i)) diff --git a/lisp/org/org-table.el b/lisp/org/org-table.el index c4daed16656..c301bc6af1a 100644 --- a/lisp/org/org-table.el +++ b/lisp/org/org-table.el @@ -462,14 +462,14 @@ This may be useful when columns have been shrunk." (when pos (goto-char pos)) (goto-char (line-beginning-position)) (let ((end (line-end-position)) str) - (backward-char) + (goto-char (1- pos)) (while (progn (forward-char 1) (< (point) end)) (let ((ov (car (overlays-at (point))))) (if (not ov) (push (char-to-string (char-after)) str) (push (overlay-get ov 'display) str) (goto-char (1- (overlay-end ov)))))) - (format "%s" (mapconcat #'identity (reverse str) ""))))) + (format "|%s" (mapconcat #'identity (reverse str) ""))))) (defvar-local org-table-header-overlay nil) (defun org-table-header-set-header () @@ -5465,7 +5465,7 @@ The table is taken from the parameter TXT, or from the buffer at point." (nreverse table))))) (defun org-table-collapse-header (table &optional separator max-header-lines) - "Collapse the lines before 'hline into a single header. + "Collapse the lines before `hline' into a single header. The given TABLE is a list of lists as returned by `org-table-to-lisp'. The leading lines before the first `hline' symbol are considered diff --git a/lisp/org/org-version.el b/lisp/org/org-version.el index e82dbbf398c..dc689662b7d 100644 --- a/lisp/org/org-version.el +++ b/lisp/org/org-version.el @@ -5,13 +5,13 @@ (defun org-release () "The release version of Org. Inserted by installing Org mode or when a release is made." - (let ((org-release "9.5.2")) + (let ((org-release "9.5.3")) org-release)) ;;;###autoload (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-25-gaf6f12")) + (let ((org-git-version "release_9.5.3-3-gd54104")) org-git-version)) (provide 'org-version) diff --git a/lisp/org/org.el b/lisp/org/org.el index d656a51591e..1fc4251a340 100644 --- a/lisp/org/org.el +++ b/lisp/org/org.el @@ -9,7 +9,7 @@ ;; Homepage: https://orgmode.org ;; Package-Requires: ((emacs "25.1")) -;; Version: 9.5.2 +;; Version: 9.5.3 ;; This file is part of GNU Emacs. ;; @@ -199,6 +199,7 @@ Stars are put in group 1 and the trimmed body in group 2.") (declare-function org-update-radio-target-regexp "ol" ()) (defvar org-element-paragraph-separate) +(defvar org-element--timestamp-regexp) (defvar org-indent-indentation-per-level) (defvar org-radio-target-regexp) (defvar org-target-link-regexp) @@ -15011,16 +15012,24 @@ value is equivalent to `inactive'. When at a timestamp, return the position of the point as a symbol among `bracket', `after', `year', `month', `hour', `minute', `day' or a number of character from the last know part of the -time stamp. +time stamp. If diary sexp timestamps, any point inside the timestamp +is considered `day' (i.e. only `bracket', `day', and `after' return +values are possible). When matching, the match groups are the following: - group 1: year - group 2: month - group 3: day number - group 4: day name + group 1: year, if any + group 2: month, if any + group 3: day number, if any + group 4: day name, if any group 5: hours, if any group 6: minutes, if any" - (let* ((regexp (if extended org-ts-regexp3 org-ts-regexp2)) + (let* ((regexp + (if extended + (if (eq extended 'agenda) + (rx (or (regexp org-ts-regexp3) + (regexp org-element--timestamp-regexp))) + org-ts-regexp3) + org-ts-regexp2)) (pos (point)) (match? (let ((boundaries (org-in-regexp regexp))) @@ -15051,7 +15060,8 @@ When matching, the match groups are the following: ((org-pos-in-match-range pos 8) 'minute) ((or (org-pos-in-match-range pos 4) (org-pos-in-match-range pos 5)) 'day) - ((and (> pos (or (match-end 8) (match-end 5))) + ((and (or (match-end 8) (match-end 5)) + (> pos (or (match-end 8) (match-end 5))) (< pos (match-end 0))) (- pos (or (match-end 8) (match-end 5)))) (t 'day)))) diff --git a/lisp/org/ox-html.el b/lisp/org/ox-html.el index 5de0b5d675c..9cf9125aebd 100644 --- a/lisp/org/ox-html.el +++ b/lisp/org/ox-html.el @@ -442,7 +442,7 @@ property on the headline itself.") { font-size: 10px; font-weight: bold; white-space: nowrap; } .org-info-js_search-highlight { background-color: #ffff00; color: #000000; font-weight: bold; } - .org-svg { width: 90%; } + .org-svg { } </style>" "The default style specification for exported HTML files. You can use `org-html-head' and `org-html-head-extra' to add to @@ -2909,7 +2909,7 @@ Starred and \"displaymath\" environments are not numbered." (defun org-html--unlabel-latex-environment (latex-frag) "Change environment in LATEX-FRAG string to an unnumbered one. -For instance, change an 'equation' environment to 'equation*'." +For instance, change an `equation' environment to `equation*'." (replace-regexp-in-string "\\`[ \t]*\\\\begin{\\([^*]+?\\)}" "\\1*" diff --git a/lisp/org/ox-publish.el b/lisp/org/ox-publish.el index 636bd0d2ae3..51e2352b4e8 100644 --- a/lisp/org/ox-publish.el +++ b/lisp/org/ox-publish.el @@ -839,7 +839,7 @@ in `org-export-options-alist' or in export back-ends. In the latter case, optional argument BACKEND has to be set to the back-end where the option is defined, e.g., - (org-publish-find-property file :subtitle 'latex) + (org-publish-find-property file :subtitle \\='latex) Return value may be a string or a list, depending on the type of PROPERTY, i.e. \"behavior\" parameter from `org-export-options-alist'." diff --git a/lisp/outline.el b/lisp/outline.el index 696d109f1ee..7fd43195cc0 100644 --- a/lisp/outline.el +++ b/lisp/outline.el @@ -178,13 +178,22 @@ in the file it applies to.") map)) (defcustom outline-minor-mode-cycle-filter nil - "Filter out positions on the heading available for cycling." + "Control where on a heading the visibility-cycling commands are bound to keys. +This option controls, in Outline minor mode, where on a heading typing +the key sequences bound to visibility-cycling commands like `outline-cycle' +and `outline-cycle-buffer' will invoke those commands. By default, you can +invoke these commands by typing `TAB' and `S-TAB' anywhere on a heading line, +but customizing this option can make those bindings be in effect only at +specific positions on the heading, like only at the line's beginning or +line's end. This allows these keys to be bound to their usual commands, +as determined by the major mode, elsewhere on the heading lines. +This option is only in effect when `outline-minor-mode-cycle' is non-nil." :type '(choice (const :tag "Everywhere" nil) (const :tag "At line beginning" bolp) (const :tag "Not at line beginning" (lambda () (not (bolp)))) (const :tag "At line end" eolp) - (function :tag "Custom filter")) + (function :tag "Custom filter function")) :version "28.1") (defvar outline-minor-mode-cycle) @@ -371,28 +380,33 @@ After that, changing the prefix key requires manipulating keymaps." (set-default sym val))) (defcustom outline-minor-mode-cycle nil - "Enable cycling of headings in `outline-minor-mode'. -When enabled, it puts a keymap with cycling keys on heading lines. -When point is on a heading line, then typing `TAB' cycles between `hide all', -`headings only' and `show all' (`outline-cycle'). Typing `S-TAB' on -a heading line cycles the whole buffer (`outline-cycle-buffer'). -Typing these keys anywhere outside heading lines uses their default bindings." + "Enable visibility-cycling commands on headings in `outline-minor-mode'. +If enabled, typing `TAB' on a heading line cycles the visibility +state of that heading's body between `hide all', `headings only' +and `show all' (`outline-cycle'), and typing `S-TAB' on a heading +line likewise cycles the visibility state of the whole buffer +\(`outline-cycle-buffer'). +Typing these keys anywhere outside heading lines invokes their default +bindings, per the current major mode." :type 'boolean :safe #'booleanp :version "28.1") (defcustom outline-minor-mode-highlight nil - "Highlight headings in `outline-minor-mode' using font-lock keywords. -Non-nil value works well only when outline font-lock keywords -don't conflict with the major mode's font-lock keywords. -When t, it puts outline faces only if there are no major mode's faces -on headings. When `override', it completely overwrites major mode's -faces with outline faces. When `append', it tries to append outline -faces to major mode's faces." - :type '(choice (const :tag "No highlighting" nil) - (const :tag "Overwrite major mode faces" override) - (const :tag "Append outline faces to major mode faces" append) - (const :tag "Highlight separately from major mode faces" t)) + "Whether to highlight headings in `outline-minor-mode' using font-lock keywords. +This option controles whether `outline-minor-mode' will use its font-lock +keywords to highlight headings, which could potentially conflict with +font-lock faces defined by the major mode. Thus, a non-nil value will +work well only when there's no such conflict. +If the value is t, use outline faces only if there are no major mode's +font-lock faces on headings. When `override', completely overwrite major +mode's font-lock faces with outline faces. When `append', try to append +outline font-lock faces to those of major mode." + :type '(choice (const :tag "Do not use outline font-lock highlighting" nil) + (const :tag "Overwrite major mode font-lock faces" override) + (const :tag "Append outline font-lock faces to major mode's" + append) + (const :tag "Highlight with outline font-lock faces only if major mode doesn't" t)) :safe #'symbolp :version "28.1") @@ -1488,7 +1502,7 @@ LEVEL, decides of subtree visibility according to (defun outline--cycle-state () "Return the cycle state of current heading. -Return either 'hide-all, 'headings-only, or 'show-all." +Return either `hide-all', `headings-only', or `show-all'." (save-excursion (let (start end ov-list heading-end) (outline-back-to-heading) @@ -1521,11 +1535,14 @@ Return either 'hide-all, 'headings-only, or 'show-all." (save-excursion (outline-end-of-subtree) (point))))) (defun outline-cycle () - "Cycle between `hide all', `headings only' and `show all'. + "Cycle visibility state of the current heading line's body. -`Hide all' means hide all subheadings and their bodies. -`Headings only' means show sub headings but not their bodies. -`Show all' means show all subheadings and their bodies." +This cycles the visibility of the current heading line's subheadings +and body between `hide all', `headings only' and `show all'. + +`Hide all' means hide all the subheadings and their bodies. +`Headings only' means show the subheadings, but not their bodies. +`Show all' means show all the subheadings and their bodies." (interactive) (condition-case nil (pcase (outline--cycle-state) @@ -1547,7 +1564,15 @@ Return either 'hide-all, 'headings-only, or 'show-all." "Internal variable used for tracking buffer cycle state.") (defun outline-cycle-buffer () - "Cycle the whole buffer like in `outline-cycle'." + "Cycle visibility state of the body lines of the whole buffer. + +This cycles the visibility of all the subheadings and bodies of all +the heading lines in the buffer. It cycles them between `hide all', +`headings only' and `show all'. + +`Hide all' means hide all the buffer's subheadings and their bodies. +`Headings only' means show all the subheadings, but not their bodies. +`Show all' means show all the buffer's subheadings and their bodies." (interactive) (let (has-top-level) (save-excursion diff --git a/lisp/paren.el b/lisp/paren.el index 4e67a4ea4f7..4c268dbf771 100644 --- a/lisp/paren.el +++ b/lisp/paren.el @@ -225,6 +225,13 @@ It is the default value of `show-paren-data-function'." (let* ((temp (show-paren--locate-near-paren)) (dir (car temp)) (outside (cdr temp)) + ;; If we're inside a comment, then we probably want to blink + ;; a matching parentheses in the comment. So don't ignore + ;; comments in that case. + (parse-sexp-ignore-comments + (if (ppss-comment-depth (syntax-ppss)) + nil + parse-sexp-ignore-comments)) pos mismatch here-beg here-end) ;; ;; Find the other end of the sexp. diff --git a/lisp/play/dunnet.el b/lisp/play/dunnet.el index 07f27374df7..b859176bb47 100644 --- a/lisp/play/dunnet.el +++ b/lisp/play/dunnet.el @@ -898,7 +898,7 @@ Regular objects have whole numbers lower than 255. Objects that cannot be taken but might move and are described during room description are negative. Stuff that is described and might change are 255, and are -handled specially by 'dun-describe-room.") +handled specially by `dun-describe-room'.") (defconst dun-room-silents (list nil (list obj-tree obj-coconut) ;; dead-end diff --git a/lisp/progmodes/cc-align.el b/lisp/progmodes/cc-align.el index 8298d5fef04..e14f5b9058f 100644 --- a/lisp/progmodes/cc-align.el +++ b/lisp/progmodes/cc-align.el @@ -202,6 +202,58 @@ Works with: arglist-cont-nonempty, arglist-close." (skip-chars-forward " \t")) (vector (current-column))))))) +(defun c-lineup-argcont-1 (elem) + ;; Move to the start of the current arg and return non-nil, otherwise + ;; return nil. + (beginning-of-line) + + (when (eq (car elem) 'arglist-cont-nonempty) + ;; Our argument list might not be the innermost one. If it + ;; isn't, go back to the first position in it. We do this by + ;; stepping back over open parens until we get to the open paren + ;; of our argument list. + (let ((open-paren (c-langelem-2nd-pos c-syntactic-element)) + (paren-state (c-parse-state))) + (while (not (eq (car paren-state) open-paren)) + (unless (consp (car paren-state)) ;; ignore matched braces + (goto-char (car paren-state))) + (setq paren-state (cdr paren-state))))) + + (let ((start (point)) c) + + (when (bolp) + ;; Previous line ending in a comma means we're the start of an + ;; argument. This should quickly catch most cases not for us. + ;; This case is only applicable if we're the innermost arglist. + (c-backward-syntactic-ws) + (setq c (char-before))) + + (unless (eq c ?,) + ;; In a gcc asm, ":" on the previous line means the start of an + ;; argument. And lines starting with ":" are not for us, don't + ;; want them to indent to the preceding operand. + (let ((gcc-asm (save-excursion + (goto-char start) + (c-in-gcc-asm-p)))) + (unless (and gcc-asm + (or (eq c ?:) + (save-excursion + (goto-char start) + (looking-at "[ \t]*:")))) + + (c-lineup-argcont-scan (if gcc-asm ?:)) + t))))) + +(defun c-lineup-argcont-scan (&optional other-match) + ;; Find the start of an argument, for `c-lineup-argcont'. + (when (zerop (c-backward-token-2 1 t)) + (let ((c (char-after))) + (if (or (eq c ?,) (eq c other-match)) + (progn + (forward-char) + (c-forward-syntactic-ws)) + (c-lineup-argcont-scan other-match))))) + ;; Contributed by Kevin Ryde <user42@zip.com.au>. (defun c-lineup-argcont (elem) "Line up a continued argument. @@ -217,56 +269,30 @@ but of course only between operand specifications, not in the expressions for the operands. Works with: arglist-cont, arglist-cont-nonempty." - (save-excursion - (beginning-of-line) + (when (c-lineup-argcont-1 elem) + (vector (current-column))))) - (when (eq (car elem) 'arglist-cont-nonempty) - ;; Our argument list might not be the innermost one. If it - ;; isn't, go back to the last position in it. We do this by - ;; stepping back over open parens until we get to the open paren - ;; of our argument list. - (let ((open-paren (c-langelem-2nd-pos c-syntactic-element)) - (paren-state (c-parse-state))) - (while (not (eq (car paren-state) open-paren)) - (unless (consp (car paren-state)) ;; ignore matched braces - (goto-char (car paren-state))) - (setq paren-state (cdr paren-state))))) - - (let ((start (point)) c) - - (when (bolp) - ;; Previous line ending in a comma means we're the start of an - ;; argument. This should quickly catch most cases not for us. - ;; This case is only applicable if we're the innermost arglist. - (c-backward-syntactic-ws) - (setq c (char-before))) - - (unless (eq c ?,) - ;; In a gcc asm, ":" on the previous line means the start of an - ;; argument. And lines starting with ":" are not for us, don't - ;; want them to indent to the preceding operand. - (let ((gcc-asm (save-excursion - (goto-char start) - (c-in-gcc-asm-p)))) - (unless (and gcc-asm - (or (eq c ?:) - (save-excursion - (goto-char start) - (looking-at "[ \t]*:")))) - - (c-lineup-argcont-scan (if gcc-asm ?:)) - (vector (current-column)))))))) +(defun c-lineup-argcont-+ (langelem) + "Indent an argument continuation `c-basic-offset' in from the first argument. -(defun c-lineup-argcont-scan (&optional other-match) - ;; Find the start of an argument, for `c-lineup-argcont'. - (when (zerop (c-backward-token-2 1 t)) - (let ((c (char-after))) - (if (or (eq c ?,) (eq c other-match)) - (progn - (forward-char) - (c-forward-syntactic-ws)) - (c-lineup-argcont-scan other-match))))) +This first argument is that on a previous line at the same level of nesting. + +foo (xyz, uvw, aaa + bbb + ccc + + ddd + eee + fff); <- c-lineup-argcont-+ + <--> c-basic-offset + +Only continuation lines like this are touched, nil being returned +on lines which are the start of an argument. + +Works with: arglist-cont, arglist-cont-nonempty." + (save-excursion + (when (c-lineup-argcont-1 langelem) ; Check we've got a continued argument... + ;; ... but ignore the position found. + (goto-char (c-langelem-2nd-pos c-syntactic-element)) + (forward-char) + (c-forward-syntactic-ws) + (vector (+ (current-column) c-basic-offset))))) (defun c-lineup-arglist-intro-after-paren (_langelem) "Line up a line to just after the open paren of the surrounding paren diff --git a/lisp/progmodes/cc-styles.el b/lisp/progmodes/cc-styles.el index 8fe8402b1d8..1cf14d52d55 100644 --- a/lisp/progmodes/cc-styles.el +++ b/lisp/progmodes/cc-styles.el @@ -180,6 +180,7 @@ (inclass . +) (inline-open . 0)))) ("linux" + (indent-tabs-mode . t) (c-basic-offset . 8) (c-comment-only-line-offset . 0) (c-hanging-braces-alist . ((brace-list-open) diff --git a/lisp/progmodes/compile.el b/lisp/progmodes/compile.el index e75a44b6537..6753cf0b027 100644 --- a/lisp/progmodes/compile.el +++ b/lisp/progmodes/compile.el @@ -1752,6 +1752,13 @@ If nil, ask to kill it." :type 'boolean :version "24.3") +(defcustom compilation-max-output-line-length 400 + "Output lines that are longer than this value will be hidden. +If nil, don't hide anything." + :type '(choice (const :tag "Hide nothing" nil) + integer) + :version "29.1") + (defun compilation--update-in-progress-mode-line () ;; `compilation-in-progress' affects the mode-line of all ;; buffers when it changes from nil to non-nil or vice-versa. @@ -2426,13 +2433,16 @@ and runs `compilation-filter-hook'." ;; We used to use `insert-before-markers', so that windows with ;; point at `process-mark' scroll along with the output, but we ;; now use window-point-insertion-type instead. - (insert string) + (if (not compilation-max-output-line-length) + (insert string) + (dolist (line (string-lines string nil t)) + (compilation--insert-abbreviated-line + line compilation-max-output-line-length))) (unless comint-inhibit-carriage-motion (comint-carriage-motion (process-mark proc) (point))) (set-marker (process-mark proc) (point)) ;; Update the number of errors in compilation-mode-line-errors (compilation--ensure-parse (point)) - ;; (setq-local compilation-buffer-modtime (current-time)) (run-hooks 'compilation-filter-hook)) (goto-char pos) (narrow-to-region min max) @@ -2440,6 +2450,40 @@ and runs `compilation-filter-hook'." (set-marker min nil) (set-marker max nil)))))) +(defun compilation--insert-abbreviated-line (string width) + (if (and (> (current-column) 0) + (get-text-property (1- (point)) 'button)) + ;; We already have an abbreviation; just add the string to it. + (let ((beg (point))) + (insert string) + (add-text-properties + beg + ;; Don't make the final newline invisible. + (if (= (aref string (1- (length string))) ?\n) + (1- (point)) + (point)) + (text-properties-at (1- beg)))) + (insert string) + ;; If we exceeded the limit, hide the last portion of the line. + (when (> (current-column) width) + (let ((start (save-excursion + (move-to-column width) + (point)))) + (buttonize-region + start (point) + (lambda (start) + (let ((inhibit-read-only t)) + (remove-text-properties start (save-excursion + (goto-char start) + (line-end-position)) + (text-properties-at start))))) + (put-text-property + start (if (= (aref string (1- (length string))) ?\n) + ;; Don't hide the final newline. + (1- (point)) + (point)) + 'display (if (char-displayable-p ?…) "[…]" "[...]")))))) + (defsubst compilation-buffer-internal-p () "Test if inside a compilation buffer." (local-variable-p 'compilation-locs)) diff --git a/lisp/progmodes/cperl-mode.el b/lisp/progmodes/cperl-mode.el index 94ecc45b15f..3742286e5d3 100644 --- a/lisp/progmodes/cperl-mode.el +++ b/lisp/progmodes/cperl-mode.el @@ -64,7 +64,7 @@ ;; This mode supports font-lock, imenu and mode-compile. In the ;; hairy version font-lock is on, but you should activate imenu ;; yourself (note that mode-compile is not standard yet). Well, you -;; can use imenu from keyboard anyway (M-x imenu), but it is better +;; can use imenu from keyboard anyway (M-g i), but it is better ;; to bind it like that: ;; (define-key global-map [M-S-down-mouse-3] 'imenu) diff --git a/lisp/progmodes/ebrowse.el b/lisp/progmodes/ebrowse.el index 17cc537e38e..16069f75aeb 100644 --- a/lisp/progmodes/ebrowse.el +++ b/lisp/progmodes/ebrowse.el @@ -3633,7 +3633,12 @@ If regular expression is nil, repeat last search." ;;;###autoload (defun ebrowse-tags-query-replace (from to) "Query replace FROM with TO in all files of a class tree. -With prefix arg, process files of marked classes only." +With prefix arg, process files of marked classes only. + +As each match is found, the user must type a character saying +what to do with it. Type SPC or `y' to replace the match, +DEL or `n' to skip and go to the next match. For more directions, +type \\[help-command] at that time." (interactive "sTree query replace (regexp): \nsTree query replace %s by: ") (setq ebrowse-tags-loop-call diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 0dfff32f20d..a4088fa4676 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -779,7 +779,7 @@ functions are annotated with \"<f>\" via the (defun elisp--xref-make-xref (type symbol file &optional summary) "Return an xref for TYPE SYMBOL in FILE. TYPE must be a type in `find-function-regexp-alist' (use nil for -'defun). If SUMMARY is non-nil, use it for the summary; +`defun'). If SUMMARY is non-nil, use it for the summary; otherwise build the summary from TYPE and SYMBOL." (xref-make (or summary (format elisp--xref-format (or type 'defun) symbol)) @@ -1614,8 +1614,6 @@ Return the result of evaluation." ;; printing, not while evaluating. (defvar elisp--eval-defun-result) (let ((debug-on-error eval-expression-debug-on-error) - (print-length eval-expression-print-length) - (print-level eval-expression-print-level) elisp--eval-defun-result) (save-excursion ;; Arrange for eval-region to "read" the (possibly) altered form. @@ -1630,10 +1628,17 @@ Return the result of evaluation." (setq beg (point)) (setq form (funcall load-read-function (current-buffer))) (setq end (point))) - ;; Alter the form if necessary. - (let ((form (eval-sexp-add-defvars - (elisp--eval-defun-1 - (macroexpand form))))) + ;; Alter the form if necessary. We bind `print-level' (etc.) + ;; in the form itself, because we want evalling the form to + ;; use the original values, while we want the printing to use + ;; `eval-expression-print-length' (etc.). + (let ((form `(let ((print-level ,print-level) + (print-length ,print-length)) + ,(eval-sexp-add-defvars + (elisp--eval-defun-1 + (macroexpand form))))) + (print-length eval-expression-print-length) + (print-level eval-expression-print-level)) (eval-region beg end standard-output (lambda (_ignore) ;; Skipping to the end of the specified region @@ -2083,7 +2088,7 @@ current buffer state and calls REPORT-FN when done." :connection-type 'pipe :sentinel (lambda (proc _event) - (when (eq (process-status proc) 'exit) + (unless (process-live-p proc) (unwind-protect (cond ((not (and (buffer-live-p source-buffer) diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el index e1b1e67dbcf..7766694edff 100644 --- a/lisp/progmodes/etags.el +++ b/lisp/progmodes/etags.el @@ -1839,7 +1839,13 @@ Also see the documentation of the `tags-file-name' variable." Third arg DELIMITED (prefix arg) means replace only word-delimited matches. If you exit (\\[keyboard-quit], RET or q), you can resume the query replace with the command \\[fileloop-continue]. -For non-interactive use, superseded by `fileloop-initialize-replace'." + +As each match is found, the user must type a character saying +what to do with it. Type SPC or `y' to replace the match, +DEL or `n' to skip and go to the next match. For more directions, +type \\[help-command] at that time. + +For non-interactive use, this is superseded by `fileloop-initialize-replace'." (declare (advertised-calling-convention (from to &optional delimited) "27.1")) (interactive (query-replace-read-args "Tags query replace (regexp)" t t)) (fileloop-initialize-replace diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index 83d7bc8641c..b5f4fff3c31 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -1358,6 +1358,11 @@ This is a suitable place for placing the `flymake-error-counter', Separating each of these with space is not necessary." :type '(repeat (choice string symbol))) +(defcustom flymake-mode-line-lighter "Flymake" + "The string to use in the Flymake mode line." + :type 'string + :version "29.1") + (defvar flymake-mode-line-title '(:eval (flymake--mode-line-title)) "Mode-line construct to show Flymake's mode name and menu.") @@ -1386,7 +1391,7 @@ correctly.") (defun flymake--mode-line-title () `(:propertize - "Flymake" + ,flymake-mode-line-lighter mouse-face mode-line-highlight help-echo ,(lambda (&rest _) @@ -1637,6 +1642,8 @@ buffer." (defun flymake-show-buffer-diagnostics () "Show a list of Flymake diagnostics for current buffer." (interactive) + (unless flymake-mode + (user-error "Flymake mode is not enabled in the current buffer")) (let* ((name (flymake--diagnostics-buffer-name)) (source (current-buffer)) (target (or (get-buffer name) diff --git a/lisp/progmodes/gdb-mi.el b/lisp/progmodes/gdb-mi.el index a35a7deb4b1..089c273bc6d 100644 --- a/lisp/progmodes/gdb-mi.el +++ b/lisp/progmodes/gdb-mi.el @@ -1581,7 +1581,7 @@ Buffer mode and name are selected according to buffer type. If buffer has trigger associated with it in `gdb-buffer-rules', this trigger is subscribed to `gdb-buf-publisher' and called with -'update argument." +`update' argument." (or (gdb-get-buffer buffer-type thread) (let ((rules (assoc buffer-type gdb-buffer-rules)) (new (generate-new-buffer "limbo"))) diff --git a/lisp/progmodes/grep.el b/lisp/progmodes/grep.el index 17905dec2eb..7620536b4b6 100644 --- a/lisp/progmodes/grep.el +++ b/lisp/progmodes/grep.el @@ -456,7 +456,7 @@ buffer `default-directory'." (defvar grep-mode-font-lock-keywords '(;; Command output lines. - (": \\(.+\\): \\(?:Permission denied\\|No such \\(?:file or directory\\|device or address\\)\\)$" + (": \\(.\\{,200\\}\\): \\(?:Permission denied\\|No such \\(?:file or directory\\|device or address\\)\\)$" 1 grep-error-face) ;; remove match from grep-regexp-alist before fontifying ("^Grep[/a-zA-Z]* started.*" diff --git a/lisp/progmodes/make-mode.el b/lisp/progmodes/make-mode.el index 91307f6c09f..1a1dc3aee9a 100644 --- a/lisp/progmodes/make-mode.el +++ b/lisp/progmodes/make-mode.el @@ -889,7 +889,7 @@ Makefile mode can be configured by modifying the following variables: (setq-local comment-start-skip "#+[ \t]*") ;; Make sure TAB really inserts \t. - (setq-local indent-line-function 'indent-to-left-margin) + (setq-local indent-line-function #'insert-tab) ;; Real TABs are important in makefiles (setq indent-tabs-mode t)) diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index daaf86f3277..6c50135358f 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -1076,6 +1076,10 @@ command \\[fileloop-continue]." (defun project-query-replace-regexp (from to) "Query-replace REGEXP in all the files of the project. Stops when a match is found and prompts for whether to replace it. +At that prompt, the user must type a character saying what to do +with the match. Type SPC or `y' to replace the match, +DEL or `n' to skip and go to the next match. For more directions, +type \\[help-command] at that time. If you exit the `query-replace', you can later continue the `query-replace' loop using the command \\[fileloop-continue]." (interactive @@ -1201,18 +1205,22 @@ displayed." (display-buffer-other-frame buffer-or-name)) (defcustom project-kill-buffer-conditions - '(buffer-file-name ; All file-visiting buffers are included. + `(buffer-file-name ; All file-visiting buffers are included. ;; Most of the temp buffers in the background: - (major-mode . fundamental-mode) + ,(lambda (buf) + (not (eq (buffer-local-value 'major-mode buf) + 'fundamental-mode))) ;; non-text buffer such as xref, occur, vc, log, ... - (and (derived-mode . special-mode) - (not (major-mode . help-mode))) - (derived-mode . compilation-mode) - (derived-mode . dired-mode) - (derived-mode . diff-mode) - (derived-mode . comint-mode) - (derived-mode . eshell-mode) - (derived-mode . change-log-mode)) + (and (major-mode . special-mode) + ,(lambda (buf) + (not (eq (buffer-local-value 'major-mode buf) + 'help-mode)))) + (major-mode . compilation-mode) + (major-mode . dired-mode) + (major-mode . diff-mode) + (major-mode . comint-mode) + (major-mode . eshell-mode) + (major-mode . change-log-mode)) "List of conditions to kill buffers related to a project. This list is used by `project-kill-buffers'. Each condition is either: @@ -1222,10 +1230,11 @@ Each condition is either: - a cons-cell, where the car describes how to interpret the cdr. The car can be one of the following: * `major-mode': the buffer is killed if the buffer's major - mode is eq to the cons-cell's cdr - * `derived-mode': the buffer is killed if the buffer's major mode is derived from the major mode denoted by the cons-cell's - cdr + cdr. + * `derived-mode': the buffer is killed if the buffer's major + mode is eq to the cons-cell's cdr (this is deprecated and will + result in a warning if used). * `not': the cdr is interpreted as a negation of a condition. * `and': the cdr is a list of recursive conditions, that all have to be met. @@ -1285,10 +1294,13 @@ form of CONDITIONS." (string-match-p c (buffer-name buf))) ((symbolp c) (funcall c buf)) - ((eq (car-safe c) 'major-mode) - (eq (buffer-local-value 'major-mode buf) - (cdr c))) ((eq (car-safe c) 'derived-mode) + (warn "The use of `derived-mode' in \ +`project--buffer-check' is deprecated.") + (provided-mode-derived-p + (buffer-local-value 'major-mode buf) + (cdr c))) + ((eq (car-safe c) 'major-mode) (provided-mode-derived-p (buffer-local-value 'major-mode buf) (cdr c))) @@ -1322,7 +1334,9 @@ identical. Only the buffers that match a condition in `project-kill-buffer-conditions' will be killed. If NO-CONFIRM is non-nil, the command will not ask the user for confirmation. NO-CONFIRM is always nil when the command is invoked -interactively." +interactively. + +Also see the `project-kill-buffers-display-buffer-list' variable." (interactive) (let* ((pr (project-current t)) (bufs (project--buffers-to-kill pr)) diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index c4d8b123a86..11ed732d282 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -706,7 +706,8 @@ avoid '==' being treated as an assignment." ;; [a] = 5 ;; [*a] = 5, 6 (,(python-font-lock-assignment-matcher - (python-rx (or "[" "(") (* space) + (python-rx (or line-start ?\;) (* space) + (or "[" "(") (* space) grouped-assignment-target (* space) (or ")" "]") (* space) assignment-operator)) @@ -1628,23 +1629,20 @@ of the statement." ;; are somehow out of whack. This has been ;; observed when using `syntax-ppss' during ;; narrowing. - (cl-assert (>= string-start last-string-end) - :show-args - "\ -Overlapping strings detected (start=%d, last-end=%d)") - (goto-char string-start) - (if (python-syntax-context 'paren) - ;; Ended up inside a paren, roll again. - (python-nav-end-of-statement t) - ;; This is not inside a paren, move to the - ;; end of this string. - (goto-char (+ (point) - (python-syntax-count-quotes - (char-after (point)) (point)))) - (setq last-string-end - (or (re-search-forward - (rx (syntax string-delimiter)) nil t) - (goto-char (point-max)))))) + (when (>= string-start last-string-end) + (goto-char string-start) + (if (python-syntax-context 'paren) + ;; Ended up inside a paren, roll again. + (python-nav-end-of-statement t) + ;; This is not inside a paren, move to the + ;; end of this string. + (goto-char (+ (point) + (python-syntax-count-quotes + (char-after (point)) (point)))) + (setq last-string-end + (or (re-search-forward + (rx (syntax string-delimiter)) nil t) + (goto-char (point-max))))))) ((python-syntax-context 'paren) ;; The statement won't end before we've escaped ;; at least one level of parenthesis. @@ -3294,22 +3292,25 @@ the python shell: (goto-char start) (python-util-forward-comment 1) (current-indentation)))) - (fillstr (and (not no-cookie) - (not starts-at-point-min-p) - (concat - (format "# -*- coding: %s -*-\n" encoding) - (make-string - ;; Subtract 2 because of the coding cookie. - (- (line-number-at-pos start) 2) ?\n))))) + (fillstr (cond (starts-at-point-min-p + nil) + ((not no-cookie) + (concat + (format "# -*- coding: %s -*-\n" encoding) + (make-string + ;; Subtract 2 because of the coding cookie. + (- (line-number-at-pos start) 2) ?\n))) + (t + (make-string (- (line-number-at-pos start) 1) ?\n))))) (with-temp-buffer (python-mode) (when fillstr (insert fillstr)) - (insert substring) - (goto-char (point-min)) (when (not toplevel-p) - (insert "if True:") + (forward-line -1) + (insert "if True:\n") (delete-region (point) (line-end-position))) + (insert substring) (when nomain (let* ((if-name-main-start-end (and nomain diff --git a/lisp/progmodes/ruby-mode.el b/lisp/progmodes/ruby-mode.el index fdc8164dc0b..a1977246341 100644 --- a/lisp/progmodes/ruby-mode.el +++ b/lisp/progmodes/ruby-mode.el @@ -508,7 +508,7 @@ This only affects the output of the command `ruby-toggle-block'." ((member tok '("unless" "if" "while" "until")) (if (save-excursion (forward-word-strictly -1) (ruby-smie--bosp)) tok "iuwu-mod")) - ((string-match-p "\\`|[*&]?\\'" tok) + ((string-match-p "\\`|[*&]*\\'" tok) (forward-char (- 1 (length tok))) (setq tok "|") (cond @@ -561,7 +561,7 @@ This only affects the output of the command `ruby-toggle-block'." ((ruby-smie--closing-pipe-p) "closing-|") (t tok))) ((string-match-p "\\`[^|]+|\\'" tok) "closing-|") - ((string-match-p "\\`|[*&]\\'" tok) + ((string-match-p "\\`|[*&]*\\'" tok) (forward-char 1) (substring tok 1)) ((and (equal tok "") (eq ?\\ (char-before)) (looking-at "\n")) diff --git a/lisp/progmodes/scheme.el b/lisp/progmodes/scheme.el index 592e2d50570..cd397733d2d 100644 --- a/lisp/progmodes/scheme.el +++ b/lisp/progmodes/scheme.el @@ -562,10 +562,20 @@ indentation." (lisp-indent-specform 2 state indent-point normal-indent) (lisp-indent-specform 1 state indent-point normal-indent))) -;; (put 'begin 'scheme-indent-function 0), say, causes begin to be indented -;; like defun if the first form is placed on the next line, otherwise -;; it is indented like any other form (i.e. forms line up under first). - +;; See `scheme-indent-function' (the function) for what these do. +;; In a nutshell: +;; . for forms with no `scheme-indent-function' property the 2nd +;; and subsequent lines will be indented with one space; +;; . if the value of the property is zero, then when the first form +;; is on a separate line, the next lines will be indented with 2 +;; spaces instead of the default one space; +;; . if the value is a positive integer N, the first N lines after +;; the first one will be indented with 4 spaces, and the rest +;; will be indented with 2 spaces; +;; . if the value is `defun', the indentation is like for `defun'; +;; . if the value is a function, it will be called to produce the +;; required indentation. +;; See also http://community.schemewiki.org/?emacs-indentation. (put 'begin 'scheme-indent-function 0) (put 'case 'scheme-indent-function 1) (put 'delay 'scheme-indent-function 0) @@ -576,12 +586,16 @@ indentation." (put 'letrec 'scheme-indent-function 1) (put 'let-values 'scheme-indent-function 1) ; SRFI 11 (put 'let*-values 'scheme-indent-function 1) ; SRFI 11 +(put 'and-let* 'scheme-indent-function 1) ; SRFI 2 (put 'sequence 'scheme-indent-function 0) ; SICP, not r4rs (put 'let-syntax 'scheme-indent-function 1) (put 'letrec-syntax 'scheme-indent-function 1) (put 'syntax-rules 'scheme-indent-function 1) (put 'syntax-case 'scheme-indent-function 2) ; not r5rs +(put 'with-syntax 'scheme-indent-function 1) (put 'library 'scheme-indent-function 1) ; R6RS +;; Part of at least Guile, Chez Scheme, Chicken +(put 'eval-when 'scheme-indent-function 1) (put 'call-with-input-file 'scheme-indent-function 1) (put 'call-with-port 'scheme-indent-function 1) @@ -605,6 +619,14 @@ indentation." ;; SRFI-8 (put 'receive 'scheme-indent-function 2) +;; SRFI-204 (withdrawn, but provided in many implementations, see the SRFI text) +(put 'match 'scheme-indent-function 1) +(put 'match-lambda 'scheme-indent-function 0) +(put 'match-lambda* 'scheme-indent-function 0) +(put 'match-let 'scheme-indent-function 'scheme-let-indent) +(put 'match-let* 'scheme-indent-function 1) +(put 'match-letrec 'scheme-indent-function 1) + ;;;; MIT Scheme specific indentation. (if scheme-mit-dialect diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el index 13fba0c7058..979b743a65d 100644 --- a/lisp/progmodes/sql.el +++ b/lisp/progmodes/sql.el @@ -3216,7 +3216,7 @@ For both `:file' and `:completion', there can also be a (cond ((plist-member plist :file) (let ((file-name - (read-file-name prompt + (read-file-name prompt-def (file-name-directory last-value) default (if (plist-member plist :must-match) @@ -3246,7 +3246,7 @@ For both `:file' and `:completion', there can also be a default)) ((plist-get plist :number) - (read-number prompt (or default last-value 0))) + (read-number (concat prompt ": ") (or default last-value 0))) (t (read-string prompt-def last-value history-var default)))))) @@ -3318,7 +3318,7 @@ function like this: (sql-get-login \\='user \\='password \\='database)." (sql-get-login-ext 'sql-server "Server" 'sql-server-history plist)) ('database - (sql-get-login-ext 'sql-database "Database: " + (sql-get-login-ext 'sql-database "Database" 'sql-database-history plist)) ('port @@ -3648,94 +3648,69 @@ Allows the suppression of continuation prompts.") (defvar sql-preoutput-hold nil) -(defun sql-starts-with-prompt-re () - "Anchor the prompt expression at the beginning of the output line. -Remove the start of line regexp." - (concat "\\`" comint-prompt-regexp)) - -(defun sql-ends-with-prompt-re () - "Anchor the prompt expression at the end of the output line. -Match a SQL prompt or a password prompt." - (concat "\\(?:\\(?:" sql-prompt-regexp "\\)\\|" - "\\(?:" comint-password-prompt-regexp "\\)\\)\\'")) - (defun sql-interactive-remove-continuation-prompt (oline) "Strip out continuation prompts out of the OLINE. Added to the `comint-preoutput-filter-functions' hook in a SQL -interactive buffer. If `sql-output-newline-count' is greater than -zero, then an output line matching the continuation prompt is filtered -out. If the count is zero, then a newline is inserted into the output -to force the output from the query to appear on a new line. - -The complication to this filter is that the continuation prompts -may arrive in multiple chunks. If they do, then the function -saves any unfiltered output in a buffer and prepends that buffer -to the next chunk to properly match the broken-up prompt. - -If the filter gets confused, it should reset and stop filtering -to avoid deleting non-prompt output." - - ;; continue gathering lines of text iff - ;; + we know what a prompt looks like, and - ;; + there is held text, or - ;; + there are continuation prompt yet to come, or - ;; + not just a prompt string +interactive buffer. The complication to this filter is that the +continuation prompts may arrive in multiple chunks. If they do, +then the function saves any unfiltered output in a buffer and +prepends that buffer to the next chunk to properly match the +broken-up prompt. + +The filter goes into play only if something is already +accumulated, or we're waiting for continuation +prompts (`sql-output-newline-count' is positive). In this case: +- Accumulate process output into `sql-preoutput-hold'. +- Remove any complete prompts / continuation prompts that we're waiting + for. +- In case we're expecting more prompts - return all currently + accumulated _complete_ lines, leaving the rest for the next + invocation. They will appear in the output immediately. This way we + don't accumulate large chunks of data for no reason. +- If we found all expected prompts - just return all current accumulated + data." (when (and comint-prompt-regexp - (or (> (length (or sql-preoutput-hold "")) 0) - (> (or sql-output-newline-count 0) 0) - (not (or (string-match sql-prompt-regexp oline) - (and sql-prompt-cont-regexp - (string-match sql-prompt-cont-regexp oline)))))) - + ;; We either already have something held, or expect + ;; prompts + (or sql-preoutput-hold + (and sql-output-newline-count + (> sql-output-newline-count 0)))) (save-match-data - (let (prompt-found last-nl) - - ;; Add this text to what's left from the last pass - (setq oline (concat sql-preoutput-hold oline) - sql-preoutput-hold "") - - ;; If we are looking for multiple prompts - (when (and (integerp sql-output-newline-count) - (>= sql-output-newline-count 1)) - ;; Loop thru each starting prompt and remove it - (let ((start-re (sql-starts-with-prompt-re))) - (while (and (not (string= oline "")) - (> sql-output-newline-count 0) - (string-match start-re oline)) - (setq oline (replace-match "" nil nil oline) - sql-output-newline-count (1- sql-output-newline-count) - prompt-found t))) - - ;; If we've found all the expected prompts, stop looking - (if (= sql-output-newline-count 0) - (setq sql-output-newline-count nil) - - ;; Still more possible prompts, leave them for the next pass - (setq sql-preoutput-hold oline - oline ""))) - - ;; If no prompts were found, stop looking - (unless prompt-found - (setq sql-output-newline-count nil - oline (concat oline sql-preoutput-hold) - sql-preoutput-hold "")) - - ;; Break up output by physical lines if we haven't hit the final prompt - (let ((end-re (sql-ends-with-prompt-re))) - (unless (and (not (string= oline "")) - (string-match end-re oline) - (>= (match-end 0) (length oline))) - ;; Find everything upto the last nl - (setq last-nl 0) - (while (string-match "\n" oline last-nl) - (setq last-nl (match-end 0))) - ;; Hold after the last nl, return upto last nl - (setq sql-preoutput-hold (concat (substring oline last-nl) - sql-preoutput-hold) - oline (substring oline 0 last-nl))))))) + ;; Add this text to what's left from the last pass + (setq oline (concat sql-preoutput-hold oline) + sql-preoutput-hold nil) + + ;; If we are looking for prompts + (when (and sql-output-newline-count + (> sql-output-newline-count 0)) + ;; Loop thru each starting prompt and remove it + (while (and (not (string-empty-p oline)) + (> sql-output-newline-count 0) + (string-match comint-prompt-regexp oline)) + (setq oline (replace-match "" nil nil oline) + sql-output-newline-count (1- sql-output-newline-count))) + + ;; If we've found all the expected prompts, stop looking + (if (= sql-output-newline-count 0) + (setq sql-output-newline-count nil) + ;; Still more possible prompts, leave them for the next pass + (setq sql-preoutput-hold oline + oline ""))) + + ;; Lines that are now complete may be passed further + (when sql-preoutput-hold + (let ((last-nl 0)) + (while (string-match "\n" sql-preoutput-hold last-nl) + (setq last-nl (match-end 0))) + ;; Return up to last nl, hold after the last nl + (setq oline (substring sql-preoutput-hold 0 last-nl) + sql-preoutput-hold (substring sql-preoutput-hold last-nl)) + (when (string-empty-p sql-preoutput-hold) + (setq sql-preoutput-hold nil)))))) oline) + ;;; Sending the region to the SQLi buffer. (defvar sql-debug-send nil "Display text sent to SQL process pragmatically.") @@ -4644,6 +4619,9 @@ the call to \\[sql-product-interactive] with (setq sql-buffer (buffer-name new-sqli-buffer)) (run-hooks 'sql-set-sqli-hook))) + ;; Also set the global value. + (setq-default sql-buffer (buffer-name new-sqli-buffer)) + ;; Make sure the connection is complete ;; (Sometimes start up can be slow) ;; and call the login hook diff --git a/lisp/progmodes/tcl.el b/lisp/progmodes/tcl.el index ed6dce02c03..8c179879ce2 100644 --- a/lisp/progmodes/tcl.el +++ b/lisp/progmodes/tcl.el @@ -344,7 +344,7 @@ information): Add functions to the hook with `add-hook': - (add-hook 'tcl-mode-hook #'tcl-guess-application)") + (add-hook \\='tcl-mode-hook #\\='tcl-guess-application)") (defvar tcl-proc-list diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el index edce3fef6cf..31d50a1882e 100644 --- a/lisp/progmodes/verilog-mode.el +++ b/lisp/progmodes/verilog-mode.el @@ -3622,10 +3622,10 @@ is 0. Meaning of *single* declaration: E.g. In a module's port-list - module test(input clk, rst, x, output [1:0] y); - Here 'input clk, rst, x' is 1 *single* declaration statement, -and 'output [1:0] y' is the other single declaration. In the 1st single -declaration, POINT is moved to start of 'clk'. And in the 2nd declaration, -POINT is moved to 'y'." + Here `input clk, rst, x' is 1 *single* declaration statement, +and `output [1:0] y' is the other single declaration. In the 1st single +declaration, POINT is moved to start of `clk'. And in the 2nd declaration, +POINT is moved to `y'." (let (maxpoint old-point) diff --git a/lisp/progmodes/vhdl-mode.el b/lisp/progmodes/vhdl-mode.el index c6693b4de53..cdc8aeb1763 100644 --- a/lisp/progmodes/vhdl-mode.el +++ b/lisp/progmodes/vhdl-mode.el @@ -8396,30 +8396,30 @@ buffer." ((visible-list (vhdl-get-visible-signals)) ;; define syntactic regions where signals are read (scan-regions-list - '(;; right-hand side of signal/variable assignment + `(;; right-hand side of signal/variable assignment ;; (special case: "<=" is relational operator in a condition) - ((vhdl-re-search-forward "[<:]=" proc-end t) - (vhdl-re-search-forward ";\\|\\<\\(then\\|loop\\|report\\|severity\\|is\\)\\>" proc-end t)) + ((vhdl-re-search-forward "[<:]=" ,proc-end t) + (vhdl-re-search-forward ";\\|\\<\\(then\\|loop\\|report\\|severity\\|is\\)\\>" ,proc-end t)) ;; if condition - ((vhdl-re-search-forward "^\\s-*if\\>" proc-end t) - (vhdl-re-search-forward "\\<then\\>" proc-end t)) + ((vhdl-re-search-forward "^\\s-*if\\>" ,proc-end t) + (vhdl-re-search-forward "\\<then\\>" ,proc-end t)) ;; elsif condition - ((vhdl-re-search-forward "\\<elsif\\>" proc-end t) - (vhdl-re-search-forward "\\<then\\>" proc-end t)) + ((vhdl-re-search-forward "\\<elsif\\>" ,proc-end t) + (vhdl-re-search-forward "\\<then\\>" ,proc-end t)) ;; while loop condition - ((vhdl-re-search-forward "^\\s-*while\\>" proc-end t) - (vhdl-re-search-forward "\\<loop\\>" proc-end t)) + ((vhdl-re-search-forward "^\\s-*while\\>" ,proc-end t) + (vhdl-re-search-forward "\\<loop\\>" ,proc-end t)) ;; exit/next condition - ((vhdl-re-search-forward "\\<\\(exit\\|next\\)\\s-+\\w+\\s-+when\\>" proc-end t) - (vhdl-re-search-forward ";" proc-end t)) + ((vhdl-re-search-forward "\\<\\(exit\\|next\\)\\s-+\\w+\\s-+when\\>" ,proc-end t) + (vhdl-re-search-forward ";" ,proc-end t)) ;; assert condition - ((vhdl-re-search-forward "\\<assert\\>" proc-end t) - (vhdl-re-search-forward "\\(\\<report\\>\\|\\<severity\\>\\|;\\)" proc-end t)) + ((vhdl-re-search-forward "\\<assert\\>" ,proc-end t) + (vhdl-re-search-forward "\\(\\<report\\>\\|\\<severity\\>\\|;\\)" ,proc-end t)) ;; case expression - ((vhdl-re-search-forward "^\\s-*case\\>" proc-end t) - (vhdl-re-search-forward "\\<is\\>" proc-end t)) + ((vhdl-re-search-forward "^\\s-*case\\>" ,proc-end t) + (vhdl-re-search-forward "\\<is\\>" ,proc-end t)) ;; parameter list of procedure call, array index - ((and (re-search-forward "^\\s-*\\(\\w\\|\\.\\)+[ \t\n\r\f]*(" proc-end t) + ((and (re-search-forward "^\\s-*\\(\\w\\|\\.\\)+[ \t\n\r\f]*(" ,proc-end t) (1- (point))) (progn (backward-char) (forward-sexp) (while (looking-at "(") (forward-sexp)) (point))))) @@ -8785,7 +8785,10 @@ project is defined." (defun vhdl-electric-period (count) "`..' --> ` => '" (interactive "p") (if (and vhdl-stutter-mode (= count 1) (not (vhdl-in-literal))) - (cond ((= (preceding-char) vhdl-last-input-event) + ;; We use this-command-keys below to account for translation of + ;; kp-decimal into '.'; vhdl-last-input-event doesn't catch + ;; that. + (cond ((eq (preceding-char) (aref (this-command-keys) 0)) (progn (delete-char -1) (unless (eq (preceding-char) ? ) (insert " ")) (insert "=> "))) diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index 277934c08a2..6e763eef018 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -381,7 +381,8 @@ elements is negated: these commands will NOT prompt." (defcustom xref-after-jump-hook '(recenter xref-pulse-momentarily) - "Functions called after jumping to an xref." + "Functions called after jumping to an xref. +Also see `xref-current-item'." :type 'hook) (defcustom xref-after-return-hook '(xref-pulse-momentarily) @@ -490,7 +491,9 @@ To undo, use \\[xref-go-forward]." 'xref-current-item "29.1") -(defvar xref-current-item nil) +(defvar xref-current-item nil + "Dynamically bound to the current item being processed. +This can be used from `xref-after-jump-hook', for instance.") (defun xref-pulse-momentarily () (pcase-let ((`(,beg . ,end) @@ -747,7 +750,12 @@ references displayed in the current *xref* buffer. When called interactively, it uses '.*' as FROM, which means replace the whole name. Unless called with prefix argument, in -which case the user is prompted for both FROM and TO." +which case the user is prompted for both FROM and TO. + +As each match is found, the user must type a character saying +what to do with it. Type SPC or `y' to replace the match, +DEL or `n' to skip and go to the next match. For more directions, +type \\[help-command] at that time." (interactive (let* ((fr (if current-prefix-arg @@ -957,8 +965,8 @@ beginning of the line." (defvar xref--button-map (let ((map (make-sparse-keymap))) - (define-key map [mouse-1] #'xref-goto-xref) - (define-key map [mouse-2] #'xref-select-and-show-xref) + (define-key map [follow-link] 'mouse-face) + (define-key map [mouse-2] #'xref-goto-xref) map)) (defun xref-select-and-show-xref (event) @@ -1865,7 +1873,7 @@ to control which program to use when looking for matches." (xref--find-ignores-arguments ignores dir))) (defun xref--find-ignores-arguments (ignores dir) - "Convert IGNORES and DIR to a list of arguments for 'find'. + "Convert IGNORES and DIR to a list of arguments for `find'. IGNORES is a list of glob patterns. DIR is an absolute directory, used as the root of the ignore globs." (cl-assert (not (string-match-p "\\`~" dir))) diff --git a/lisp/recentf.el b/lisp/recentf.el index 5e2f2218614..2de98311540 100644 --- a/lisp/recentf.el +++ b/lisp/recentf.el @@ -1353,7 +1353,7 @@ to a file, and killing a buffer is counted as \"operating\" on the file. If instead you want to prioritize files that appear in buffers you switch to a lot, you can say something like the following: - (add-hook 'buffer-list-update-hook 'recentf-track-opened-file)" + (add-hook \\='buffer-list-update-hook #\\='recentf-track-opened-file)" :global t :group 'recentf :keymap recentf-mode-map diff --git a/lisp/replace.el b/lisp/replace.el index 00d30d1e383..81282deb140 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -399,7 +399,9 @@ should a regexp." (defun query-replace (from-string to-string &optional delimited start end backward region-noncontiguous-p) "Replace some occurrences of FROM-STRING with TO-STRING. As each match is found, the user must type a character saying -what to do with it. For directions, type \\[help-command] at that time. +what to do with it. Type SPC or `y' to replace the match, +DEL or `n' to skip and go to the next match. For more directions, +type \\[help-command] at that time. In Transient Mark mode, if the mark is active, operate on the contents of the region. Otherwise, operate from point to the end of the buffer's @@ -469,7 +471,9 @@ To customize possible responses, change the bindings in `query-replace-map'." (defun query-replace-regexp (regexp to-string &optional delimited start end backward region-noncontiguous-p) "Replace some things after point matching REGEXP with TO-STRING. As each match is found, the user must type a character saying -what to do with it. For directions, type \\[help-command] at that time. +what to do with it. Type SPC or `y' to replace the match, +DEL or `n' to skip and go to the next match. For more directions, +type \\[help-command] at that time. In Transient Mark mode, if the mark is active, operate on the contents of the region. Otherwise, operate from point to the end of the buffer's @@ -566,7 +570,9 @@ Interactive use of this function is deprecated in favor of the using `search-forward-regexp' and `replace-match' is preferred. As each match is found, the user must type a character saying -what to do with it. For directions, type \\[help-command] at that time. +what to do with it. Type SPC or `y' to replace the match, +DEL or `n' to skip and go to the next match. For more directions, +type \\[help-command] at that time. TO-EXPR is a Lisp expression evaluated to compute each replacement. It may reference `replace-count' to get the number of replacements already made. @@ -652,6 +658,11 @@ Use \\<minibuffer-local-map>\\[next-history-element] \ to pull the last incremental search regexp to the minibuffer that reads REGEXP. +As each match is found, the user must type a character saying +what to do with it. Type SPC or `y' to replace the match, +DEL or `n' to skip and go to the next match. For more directions, +type \\[help-command] at that time. + A prefix argument N says to use each replacement string N times before rotating to the next. Fourth and fifth arg START and END specify the region to operate on. diff --git a/lisp/ses.el b/lisp/ses.el index 59e10e777f1..7a9b35d749a 100644 --- a/lisp/ses.el +++ b/lisp/ses.el @@ -2331,7 +2331,7 @@ Narrow to print area if optional argument NONARROW is nil." "Recalculate and reprint the current cell or range. If CURCELL is non nil use it as current cell or range -without any check, otherwise function (ses-check-curcell 'range) +without any check, otherwise function (ses-check-curcell \\='range) is called. For an individual cell, shows the error if the formula or printer @@ -3774,15 +3774,15 @@ DEFINITION shall be either a string formatter, e.g.: \"%.2f\" or (\"%.2f\") for left alignment. or a lambda expression, e.g. for formatting in ISO format dates -created with a '(calcFunc-date YEAR MONTH DAY)' formula: +created with a `(calcFunc-date YEAR MONTH DAY)' formula: (lambda (x) (cond ((null val) \"\") - ((eq (car-safe x) 'date) - (let ((calc-format-date '(X YYYY \"-\" MM \"-\" DD))) + ((eq (car-safe x) \\='date) + (let ((calc-format-date \\='(X YYYY \"-\" MM \"-\" DD))) (math-format-date x))) - (t (ses-center-span val ?# 'ses-prin1)))) + (t (ses-center-span val ?# \\='ses-prin1)))) If NAME is already used to name a local printer function, then the current definition is proposed as default value, and the @@ -4122,7 +4122,7 @@ until the next nonblank column." (ses-center-span value ?~ printer)) (defun ses-prin1 (value) - "Shorthand for '(prin1-to-string VALUE t)'. + "Shorthand for `(prin1-to-string VALUE t)'. Useful to handle the default behavior in custom lambda based printer functions." (prin1-to-string value t)) diff --git a/lisp/shell.el b/lisp/shell.el index a9990f5d551..47887433d9f 100644 --- a/lisp/shell.el +++ b/lisp/shell.el @@ -528,7 +528,7 @@ Shell buffers. It implements `shell-completion-execonly' for the shell. This is useful for entering passwords. Or, add the function `comint-watch-for-password-prompt' to `comint-output-filter-functions'. -If you want to make multiple shell buffers, rename the `*shell*' buffer +If you want to make multiple shell buffers, rename the \"*shell*\" buffer using \\[rename-buffer] or \\[rename-uniquely] and start a new shell. If you want to make shell buffers limited in length, add the function @@ -575,7 +575,7 @@ buffer. By default, shell mode does nothing special when it receives a \"bell\" character (C-g or ^G). If you - (add-hook 'comint-output-filter-functions 'shell-filter-ring-bell nil t) + (add-hook \\='comint-output-filter-functions #\\='shell-filter-ring-bell nil t) from `shell-mode-hook', Emacs will call the `ding' function whenever it receives the bell character in output from a command." @@ -1033,7 +1033,9 @@ Environment variables are expanded, see function `substitute-in-file-name'." "Toggle directory tracking in this shell buffer (Shell Dirtrack mode). The `dirtrack' package provides an alternative implementation of -this feature; see the function `dirtrack-mode'." +this feature; see the function `dirtrack-mode'. Also see +`comint-osc-directory-tracker' for an escape-sequence based +solution." :lighter nil (setq list-buffers-directory (if shell-dirtrack-mode default-directory)) (if shell-dirtrack-mode diff --git a/lisp/simple.el b/lisp/simple.el index 2481d22ad13..861d9eefde9 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -222,7 +222,7 @@ rejected, and the function returns nil." (defcustom next-error-find-buffer-function #'ignore "Function called to find a `next-error' capable buffer. -This functions takes the same three arguments as the function +This function takes the same three arguments as the function `next-error-find-buffer', and should return the buffer to be used by the subsequent invocation of the command `next-error' and `previous-error'. @@ -2389,6 +2389,17 @@ function as needed." (cl-defmethod function-documentation ((function accessor)) (oclosure--accessor-docstring function)) ;; FIXME: η-reduce! +;; This should be in `oclosure.el' but that file is loaded before `cl-generic'. +(cl-defgeneric oclosure-interactive-form (_function) + "Return the interactive form of FUNCTION or nil if none. +This is called by `interactive-form' when invoked on OClosures. +It should return either nil or a two-element list of the form (interactive FORM) +where FORM is like the first arg of the `interactive' special form. +Add your methods to this generic function, but always call `interactive-form' +instead." + ;; (interactive-form function) + nil) + (defun command-execute (cmd &optional record-flag keys special) ;; BEWARE: Called directly from the C code. "Execute CMD as an editor command. @@ -3008,12 +3019,12 @@ the minibuffer contents." (defconst undo-equiv-table (make-hash-table :test 'eq :weakness t) "Table mapping redo records to the corresponding undo one. -A redo record for an undo in region maps to 'undo-in-region. +A redo record for an undo in region maps to `undo-in-region'. A redo record for ordinary undo maps to the following (earlier) undo. A redo record that undoes to the beginning of the undo list maps to t. In the rare case where there are (erroneously) consecutive nil's in `buffer-undo-list', `undo' maps the previous valid undo record to -'empty, if the previous record is a redo record, `undo' doesn't change +`empty', if the previous record is a redo record, `undo' doesn't change its mapping. To be clear, a redo record is just an undo record, the only difference @@ -4296,25 +4307,21 @@ impose the use of a shell (with its need to quote arguments)." (cond ((eq async-shell-command-buffer 'confirm-kill-process) ;; If will kill a process, query first. - (if (yes-or-no-p "A command is running in the default buffer. Kill it? ") - (kill-process proc) - (user-error "Shell command in progress"))) + (shell-command--same-buffer-confirm "Kill it") + (kill-process proc)) ((eq async-shell-command-buffer 'confirm-new-buffer) ;; If will create a new buffer, query first. - (if (yes-or-no-p "A command is running in the default buffer. Use a new buffer? ") - (setq buffer (generate-new-buffer bname)) - (user-error "Shell command in progress"))) + (shell-command--same-buffer-confirm "Use a new buffer") + (setq buffer (generate-new-buffer bname))) ((eq async-shell-command-buffer 'new-buffer) ;; It will create a new buffer. (setq buffer (generate-new-buffer bname))) ((eq async-shell-command-buffer 'confirm-rename-buffer) ;; If will rename the buffer, query first. - (if (yes-or-no-p "A command is running in the default buffer. Rename it? ") - (progn - (with-current-buffer buffer - (rename-uniquely)) - (setq buffer (get-buffer-create bname))) - (user-error "Shell command in progress"))) + (shell-command--same-buffer-confirm "Rename it") + (with-current-buffer buffer + (rename-uniquely)) + (setq buffer (get-buffer-create bname))) ((eq async-shell-command-buffer 'rename-buffer) ;; It will rename the buffer. (with-current-buffer buffer @@ -4362,6 +4369,24 @@ impose the use of a shell (with its need to quote arguments)." (shell-command-on-region (point) (point) command output-buffer nil error-buffer))))))) +(defun shell-command--same-buffer-confirm (action) + (let ((help-form + (format + "There's a command already running in the default buffer, +so we can't start a new one in the same one. + +Answering \"yes\" will %s. + +Answering \"no\" will exit without doing anything, and won't +start the new command. + +Also see the `async-shell-command-buffer' variable." + (downcase action)))) + (unless (yes-or-no-p + (format "A command is running in the default buffer. %s? " + action)) + (user-error "Shell command in progress")))) + (defun max-mini-window-lines (&optional frame) "Compute maximum number of lines for echo area in FRAME. As defined by `max-mini-window-height'. FRAME defaults to the @@ -5289,7 +5314,7 @@ If `kill-append-merge-undo' is non-nil, remove the last undo boundary in the current buffer." (let ((cur (car kill-ring))) (kill-new (if before-p (concat string cur) (concat cur string)) - (or (string= cur "") + (or (= (length cur) 0) (null (get-text-property 0 'yank-handler cur))))) (when (and kill-append-merge-undo (not buffer-read-only)) (let ((prev buffer-undo-list) @@ -5457,7 +5482,7 @@ This command's old key binding has been given to `kill-ring-save'." (let ((str (if region (funcall region-extract-function nil) (filter-buffer-substring beg end)))) - (if (eq last-command 'kill-region) + (if (eq last-command 'kill-region) (kill-append str (< end beg)) (kill-new str))) (setq deactivate-mark t) @@ -9208,14 +9233,18 @@ the completions is popped up and down." (defun previous-completion (n) "Move to the previous item in the completion list. With prefix argument N, move back N items (negative N means move -forward)." +forward). + +Also see the `completion-wrap-movement' variable." (interactive "p") (next-completion (- n))) (defun next-completion (n) "Move to the next item in the completion list. With prefix argument N, move N items (negative N means move -backward)." +backward). + +Also see the `completion-wrap-movement' variable." (interactive "p") (let ((prev (previous-single-property-change (point) 'mouse-face))) (goto-char (cond @@ -10184,6 +10213,17 @@ This is an integer indicating the UTC offset in seconds, i.e., the number of seconds east of Greenwich.") ) +(defun scratch-buffer () + "Switch to the \*scratch\* buffer. +If the buffer doesn't exist, create it first." + (interactive) + (if (get-buffer "*scratch*") + (pop-to-buffer-same-window "*scratch*") + (pop-to-buffer-same-window (get-buffer-create "*scratch*")) + (when initial-scratch-message + (insert initial-scratch-message)) + (funcall initial-major-mode))) + (provide 'simple) diff --git a/lisp/sort.el b/lisp/sort.el index 90eee01caf4..d04f075abd1 100644 --- a/lisp/sort.el +++ b/lisp/sort.el @@ -29,6 +29,8 @@ ;;; Code: +(eval-when-compile (require 'subr-x)) + (defgroup sort nil "Commands to sort text in an Emacs buffer." :group 'data) @@ -111,7 +113,8 @@ as start and end positions), and with `string<' otherwise." (lambda (a b) (string< (car a) (car b))))))) (if reverse (setq sort-lists (nreverse sort-lists))) (if messages (message "Reordering buffer...")) - (sort-reorder-buffer sort-lists old))) + (with-buffer-unmodified-if-unchanged + (sort-reorder-buffer sort-lists old)))) (if messages (message "Reordering buffer... Done")))) nil) diff --git a/lisp/startup.el b/lisp/startup.el index bf5c4a8180b..c7cf86a01e5 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -1291,12 +1291,16 @@ please check its value") (setcdr command-line-args args))) ;; Re-evaluate predefined variables whose initial value depends on - ;; the runtime context. - (when (listp custom-delayed-init-variables) - (mapc #'custom-reevaluate-setting - ;; Initialize them in the same order they were loaded, in - ;; case there are dependencies between them. - (reverse custom-delayed-init-variables))) + ;; the runtime context. But delay the warning about + ;; `user-emacs-directory' being inaccessible until after processing + ;; the init file and the command-line arguments, in case the user + ;; customized `user-emacs-directory-warning' to nil via those. + (let ((user-emacs-directory-warning nil)) + (when (listp custom-delayed-init-variables) + (mapc #'custom-reevaluate-setting + ;; Initialize them in the same order they were loaded, in + ;; case there are dependencies between them. + (reverse custom-delayed-init-variables)))) (setq custom-delayed-init-variables t) ;; Warn for invalid user name. @@ -1562,9 +1566,21 @@ please check its value") (list 'error (substitute-command-keys "Memory exhausted--use \\[save-some-buffers] then exit and restart Emacs"))) + ;; Reevaluate `user-emacs-directory-warning' before processing + ;; '--eval' arguments, so that the user could override the default + ;; value in the '--eval' forms. + (custom-reevaluate-setting 'user-emacs-directory-warning) + ;; Process the remaining args. (command-line-1 (cdr command-line-args)) + ;; Check if `user-emacs-directory' is accessible and warn if it + ;; isn't, unless `user-emacs-directory-warning' was customized to + ;; disable that warning. + (when (and user-emacs-directory-warning + (not (file-accessible-directory-p user-emacs-directory))) + (locate-user-emacs-file "")) + ;; This is a problem because, e.g. if emacs.d/gnus.el exists, ;; trying to load gnus could load the wrong file. ;; OK, it would not matter if .emacs.d were at the end of load-path. @@ -2669,7 +2685,7 @@ nil default-directory" name) ;; This is used to handle -script. It's not clear ;; we need to document it (it is totally internal). - ((member argi '("-scriptload")) + ((member argi '("-scriptload" "-scripteval")) (let* ((file (command-line-normalize-file-name (or argval (pop command-line-args-left)))) ;; Take file from default dir. @@ -2682,7 +2698,10 @@ nil default-directory" name) ;; actually exist on some systems. (when (file-exists-p truename) (setq file-ex truename)) - (command-line--load-script file-ex))) + (if (equal argi "-scripteval") + ;; This will kill Emacs. + (command-line--eval-script file-ex) + (command-line--load-script file-ex)))) ((equal argi "-insert") (setq inhibit-startup-screen t) @@ -2884,6 +2903,22 @@ nil default-directory" name) (delete-line)) (eval-buffer buffer nil file nil t))))) +(defun command-line--eval-script (file) + (load-with-code-conversion + file file nil t + (lambda (buffer _) + (with-current-buffer buffer + (goto-char (point-min)) + (when (looking-at "#!") + (forward-line)) + (let (value form) + (while (ignore-error 'end-of-file + (setq form (read (current-buffer)))) + (setq value (eval form t))) + (kill-emacs (if (numberp value) + value + 0))))))) + (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 e7d5d36461c..dec3b9190ed 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -243,18 +243,14 @@ change the list." (defmacro when (cond &rest body) "If COND yields non-nil, do BODY, else return nil. When COND yields non-nil, eval BODY forms sequentially and return -value of last one, or nil if there are none. - -\(fn COND BODY...)" +value of last one, or nil if there are none." (declare (indent 1) (debug t)) (list 'if cond (cons 'progn body))) (defmacro unless (cond &rest body) "If COND yields nil, do BODY, else return nil. When COND yields nil, eval BODY forms sequentially and return -value of last one, or nil if there are none. - -\(fn COND BODY...)" +value of last one, or nil if there are none." (declare (indent 1) (debug t)) (cons 'if (cons cond (cons nil body)))) @@ -945,6 +941,20 @@ Here's some example key sequences: For an approximate inverse of this, see `key-description'." (declare (pure t) (side-effect-free t)) (let ((res (key-parse keys))) + ;; For historical reasons, parse "C-x ( C-d C-x )" as "C-d", since + ;; `kbd' used to be a wrapper around `read-kbd-macro'. + (when (and (>= (length res) 4) + (eq (aref res 0) ?\C-x) + (eq (aref res 1) ?\() + (eq (aref res (- (length res) 2)) ?\C-x) + (eq (aref res (- (length res) 1)) ?\))) + (setq res (apply #'vector (let ((lres (append res nil))) + ;; Remove the first and last two elements. + (setq lres (cddr lres)) + (setq lres (nreverse lres)) + (setq lres (cddr lres)) + (nreverse lres))))) + (if (not (memq nil (mapcar (lambda (ch) (and (numberp ch) (<= 0 ch 127))) @@ -2371,6 +2381,102 @@ Affects only hooks run in the current buffer." (let ((delay-mode-hooks t)) ,@body))) +;;; `when-let' and friends. + +(defun internal--build-binding (binding prev-var) + "Check and build a single BINDING with PREV-VAR." + (setq binding + (cond + ((symbolp binding) + (list binding binding)) + ((null (cdr binding)) + (list (make-symbol "s") (car binding))) + (t binding))) + (when (> (length binding) 2) + (signal 'error + (cons "`let' bindings can have only one value-form" binding))) + (let ((var (car binding))) + `(,var (and ,prev-var ,(cadr binding))))) + +(defun internal--build-bindings (bindings) + "Check and build conditional value forms for BINDINGS." + (let ((prev-var t)) + (mapcar (lambda (binding) + (let ((binding (internal--build-binding binding prev-var))) + (setq prev-var (car binding)) + binding)) + bindings))) + +(defmacro if-let* (varlist then &rest else) + "Bind variables according to VARLIST and evaluate THEN or ELSE. +This is like `if-let' but doesn't handle a VARLIST of the form +\(SYMBOL SOMETHING) specially." + (declare (indent 2) + (debug ((&rest [&or symbolp (symbolp form) (form)]) + body))) + (if varlist + `(let* ,(setq varlist (internal--build-bindings varlist)) + (if ,(caar (last varlist)) + ,then + ,@else)) + `(let* () ,then))) + +(defmacro when-let* (varlist &rest body) + "Bind variables according to VARLIST and conditionally evaluate BODY. +This is like `when-let' but doesn't handle a VARLIST of the form +\(SYMBOL SOMETHING) specially." + (declare (indent 1) (debug if-let*)) + (list 'if-let* varlist (macroexp-progn body))) + +(defmacro and-let* (varlist &rest body) + "Bind variables according to VARLIST and conditionally evaluate BODY. +Like `when-let*', except if BODY is empty and all the bindings +are non-nil, then the result is non-nil." + (declare (indent 1) (debug if-let*)) + (let (res) + (if varlist + `(let* ,(setq varlist (internal--build-bindings varlist)) + (when ,(setq res (caar (last varlist))) + ,@(or body `(,res)))) + `(let* () ,@(or body '(t)))))) + +(defmacro if-let (spec then &rest else) + "Bind variables according to SPEC and evaluate THEN or ELSE. +Evaluate each binding in turn, as in `let*', stopping if a +binding value is nil. If all are non-nil return the value of +THEN, otherwise the last form in ELSE. + +Each element of SPEC is a list (SYMBOL VALUEFORM) that binds +SYMBOL to the value of VALUEFORM. An element can additionally be +of the form (VALUEFORM), which is evaluated and checked for nil; +i.e. SYMBOL can be omitted if only the test result is of +interest. It can also be of the form SYMBOL, then the binding of +SYMBOL is checked for nil. + +As a special case, interprets a SPEC of the form \(SYMBOL SOMETHING) +like \((SYMBOL SOMETHING)). This exists for backward compatibility +with an old syntax that accepted only one binding." + (declare (indent 2) + (debug ([&or (symbolp form) ; must be first, Bug#48489 + (&rest [&or symbolp (symbolp form) (form)])] + body))) + (when (and (<= (length spec) 2) + (not (listp (car spec)))) + ;; Adjust the single binding case + (setq spec (list spec))) + (list 'if-let* spec then (macroexp-progn else))) + +(defmacro when-let (spec &rest body) + "Bind variables according to SPEC and conditionally evaluate BODY. +Evaluate each binding in turn, stopping if a binding value is nil. +If all are non-nil, return the value of the last form in BODY. + +The variable list SPEC is the same as in `if-let'." + (declare (indent 1) (debug if-let)) + (list 'if-let spec (macroexp-progn body))) + + + ;; PUBLIC: find if the current mode derives from another. (defun provided-mode-derived-p (mode &rest modes) @@ -6646,9 +6752,96 @@ is inserted before adjusting the number of empty lines." ((< (- (point) start) lines) (insert (make-string (- lines (- (point) start)) ?\n)))))) -(defun string-lines (string &optional omit-nulls) +(defun string-lines (string &optional omit-nulls keep-newlines) "Split STRING into a list of lines. -If OMIT-NULLS, empty lines will be removed from the results." - (split-string string "\n" omit-nulls)) +If OMIT-NULLS, empty lines will be removed from the results. +If KEEP-NEWLINES, don't strip trailing newlines from the result +lines." + (if (equal string "") + (if omit-nulls + nil + (list "")) + (let ((lines nil) + (start 0)) + (while (< start (length string)) + (let ((newline (string-search "\n" string start))) + (if newline + (progn + (when (or (not omit-nulls) + (not (= start newline))) + (let ((line (substring string start + (if keep-newlines + (1+ newline) + newline)))) + (when (not (and keep-newlines omit-nulls + (equal line "\n"))) + (push line lines)))) + (setq start (1+ newline))) + ;; No newline in the remaining part. + (if (zerop start) + ;; Avoid a string copy if there are no newlines at all. + (push string lines) + (push (substring string start) lines)) + (setq start (length string))))) + (nreverse lines)))) + +(defun buffer-match-p (condition buffer-or-name &optional arg) + "Return non-nil if BUFFER-OR-NAME matches CONDITION. +CONDITION is either: +- a regular expression, to match a buffer name, +- a predicate function that takes a buffer object and ARG as + arguments, and returns non-nil if the buffer matches, +- a cons-cell, where the car describes how to interpret the cdr. + The car can be one of the following: + * `major-mode': the buffer matches if the buffer's major + mode is derived from the major mode denoted by the cons-cell's + cdr + * `not': the cdr is interpreted as a negation of a condition. + * `and': the cdr is a list of recursive conditions, that all have + to be met. + * `or': the cdr is a list of recursive condition, of which at + least one has to be met." + (letrec + ((buffer (get-buffer buffer-or-name)) + (match + (lambda (conditions) + (catch 'match + (dolist (condition conditions) + (when (cond + ((stringp condition) + (string-match-p condition (buffer-name buffer))) + ((functionp condition) + (if (eq 1 (cdr (func-arity condition))) + (funcall condition buffer) + (funcall condition buffer arg))) + ((eq (car-safe condition) 'major-mode) + (provided-mode-derived-p + (buffer-local-value 'major-mode buffer) + (cdr condition))) + ((eq (car-safe condition) 'not) + (not (funcall match (cdr condition)))) + ((eq (car-safe condition) 'or) + (funcall match (cdr condition))) + ((eq (car-safe condition) 'and) + (catch 'fail + (dolist (c (cdr conditions)) + (unless (funcall match c) + (throw 'fail nil))) + t))) + (throw 'match t))))))) + (funcall match (list condition)))) + +(defun match-buffers (condition &optional buffers arg) + "Return a list of buffers that match CONDITION. +See `buffer-match' for details on CONDITION. By default all +buffers are checked, this can be restricted by passing an +optional argument BUFFERS, set to a list of buffers to check. +ARG is passed to `buffer-match', for predicate conditions in +CONDITION." + (let (bufs) + (dolist (buf (or buffers (buffer-list))) + (when (buffer-match-p condition (get-buffer buf) arg) + (push buf bufs))) + bufs)) ;;; subr.el ends here diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index c4d450fe2a5..42c4b822bc6 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -229,7 +229,7 @@ a list of frames to update." (defun tab-bar--key-to-number (key) "Return the tab number represented by KEY. -If KEY is a symbol 'tab-N', where N is a tab number, the value is N. +If KEY is a symbol `tab-N', where N is a tab number, the value is N. If KEY is \\='current-tab, the value is nil. For any other value of KEY, the value is t." (cond @@ -426,7 +426,7 @@ on each new frame when the global `tab-bar-mode' is disabled, or if you want to disable the tab bar individually on each new frame when the global `tab-bar-mode' is enabled, by using - (add-hook 'after-make-frame-functions 'toggle-frame-tab-bar)" + (add-hook \\='after-make-frame-functions #\\='toggle-frame-tab-bar)" (interactive) (set-frame-parameter frame 'tab-bar-lines (if (> (frame-parameter frame 'tab-bar-lines) 0) 0 1)) @@ -915,8 +915,8 @@ when the tab is current. Return the result as a keymap." (let* ((rest (cdr (memq 'tab-bar-format-align-right tab-bar-format))) (rest (tab-bar-format-list rest)) (rest (mapconcat (lambda (item) (nth 2 item)) rest "")) - (hpos (length rest)) - (str (propertize " " 'display `(space :align-to (- right ,hpos))))) + (hpos (string-pixel-width (propertize rest 'face 'tab-bar))) + (str (propertize " " 'display `(space :align-to (- right (,hpos)))))) `((align-right menu-item ,str ignore)))) (defun tab-bar-format-global () @@ -926,7 +926,7 @@ When `tab-bar-format-global' is added to `tab-bar-format' then modes that display information on the mode line using `global-mode-string' will display the same text on the tab bar instead." - `((global menu-item ,(string-trim-right (format-mode-line global-mode-string)) ignore))) + `((global menu-item ,(format-mode-line global-mode-string) ignore))) (defun tab-bar-format-list (format-list) (let ((i 0)) diff --git a/lisp/term/common-win.el b/lisp/term/common-win.el index 7a48fc04c6c..6f1e322aba5 100644 --- a/lisp/term/common-win.el +++ b/lisp/term/common-win.el @@ -65,7 +65,6 @@ (cons 4 'ns-drag-file) (cons 5 'ns-drag-color) (cons 6 'ns-drag-text) - (cons 7 'ns-change-font) (cons 8 'ns-open-file-line) ;;; (cons 9 'ns-insert-working-text) ;;; (cons 10 'ns-delete-working-text) @@ -419,6 +418,16 @@ the operating system.") (setq defined-colors (cons this-color defined-colors)))) defined-colors))) +;;;; Session management. + +(defvar emacs-save-session-functions nil + "Special hook run when a save-session event occurs. +The functions do not get any argument. +Functions can return non-nil to inform the session manager that the +window system shutdown should be aborted. + +See also `emacs-session-save'.") + (provide 'term/common-win) ;;; common-win.el ends here diff --git a/lisp/term/haiku-win.el b/lisp/term/haiku-win.el index 955947fe6a2..5f020877325 100644 --- a/lisp/term/haiku-win.el +++ b/lisp/term/haiku-win.el @@ -46,6 +46,7 @@ (defvar haiku-initialized) (defvar haiku-signal-invalid-refs) (defvar haiku-drag-track-function) +(defvar haiku-allowed-ui-colors) (defvar haiku-dnd-selection-value nil "The local value of the special `XdndSelection' selection.") @@ -64,7 +65,8 @@ the type of DATA inside the system message (see the doc string of `haiku-drag-message' for more details).") (defvar haiku-normal-selection-encoders '(haiku-select-encode-xstring - haiku-select-encode-utf-8-string) + haiku-select-encode-utf-8-string + haiku-select-encode-file-name) "List of functions which act as selection encoders. These functions accept two arguments SELECTION and VALUE, and return an association appropriate for a serialized system @@ -74,6 +76,32 @@ content that is being put into the selection by `gui-set-selection'. See the doc string of `haiku-drag-message' for more details on the structure of the associations.") +;; This list has to be set correctly, otherwise Emacs will crash upon +;; encountering an invalid color. +(setq haiku-allowed-ui-colors + ["B_PANEL_BACKGROUND_COLOR" "B_MENU_BACKGROUND_COLOR" + "B_WINDOW_TAB_COLOR" "B_KEYBOARD_NAVIGATION_COLOR" + "B_DESKTOP_COLOR" "B_MENU_SELECTED_BACKGROUND_COLOR" + "B_MENU_ITEM_TEXT_COLOR" "B_MENU_SELECTED_ITEM_TEXT_COLOR" + "B_MENU_SELECTED_BORDER_COLOR" "B_PANEL_TEXT_COLOR" + "B_DOCUMENT_BACKGROUND_COLOR" "B_DOCUMENT_TEXT_COLOR" + "B_CONTROL_BACKGROUND_COLOR" "B_CONTROL_TEXT_COLOR" + "B_CONTROL_BORDER_COLOR" "B_CONTROL_HIGHLIGHT_COLOR" + "B_NAVIGATION_PULSE_COLOR" "B_SHINE_COLOR" + "B_SHADOW_COLOR" "B_TOOLTIP_BACKGROUND_COLOR" + "B_TOOLTIP_TEXT_COLOR" "B_WINDOW_TEXT_COLOR" + "B_WINDOW_INACTIVE_TAB_COLOR" "B_WINDOW_INACTIVE_TEXT_COLOR" + "B_WINDOW_BORDER_COLOR" "B_WINDOW_INACTIVE_BORDER_COLOR" + "B_CONTROL_MARK_COLOR" "B_LIST_BACKGROUND_COLOR" + "B_LIST_SELECTED_BACKGROUND_COLOR" "B_LIST_ITEM_TEXT_COLOR" + "B_LIST_SELECTED_ITEM_TEXT_COLOR" "B_SCROLL_BAR_THUMB_COLOR" + "B_LINK_TEXT_COLOR" "B_LINK_HOVER_COLOR" + "B_LINK_VISITED_COLOR" "B_LINK_ACTIVE_COLOR" + "B_STATUS_BAR_COLOR" "B_SUCCESS_COLOR" "B_FAILURE_COLOR"]) + +;; Also update `x-colors' to take that into account. +(setq x-colors (append haiku-allowed-ui-colors x-colors)) + (defun haiku-selection-bounds (value) "Return bounds of selection value VALUE. The return value is a list (BEG END BUF) if VALUE is a cons of @@ -199,6 +227,13 @@ VALUE will be encoded as UTF-8 and stored under the type (list "text/plain" 1296649541 (encode-coding-string value 'utf-8-unix)))) +(defun haiku-select-encode-file-name (_selection value) + "Convert VALUE to a system message association. +This takes the file name of VALUE's buffer (if it is an overlay +or a pair of markers) and turns it into a file system reference." + (when (setq value (xselect--selection-bounds value)) + (list "refs" 'ref (buffer-file-name (nth 2 value))))) + (cl-defmethod gui-backend-get-selection (type data-type &context (window-system haiku)) (if (eq data-type 'TARGETS) @@ -238,7 +273,8 @@ VALUE will be encoded as UTF-8 and stored under the type (or dir (and default-filename (file-name-directory default-filename))) mustmatch only-dir-p - (file-name-nondirectory default-filename)) + (and default-filename + (file-name-nondirectory default-filename))) (error "x-file-dialog on a tty frame"))) (defun haiku-drag-and-drop (event) @@ -270,8 +306,7 @@ VALUE will be encoded as UTF-8 and stored under the type (message "Don't know how to drop any of: %s" (mapcar #'car string))))))) -(define-key special-event-map [drag-n-drop] - 'haiku-drag-and-drop) +(define-key special-event-map [drag-n-drop] 'haiku-drag-and-drop) (defvaralias 'haiku-use-system-tooltips 'use-system-tooltips) @@ -331,6 +366,31 @@ take effect on menu items until the menu bar is updated again." (add-variable-watcher 'use-system-tooltips #'haiku-use-system-tooltips-watcher) + +;;;; Session management. + +(declare-function haiku-save-session-reply "haikufns.c") + +(defun emacs-session-save () + "SKIP: real doc in x-win.el." + (with-temp-buffer ; Saving sessions is not yet supported. + (condition-case nil + ;; A return of t means cancel the shutdown. + (run-hook-with-args-until-success + 'emacs-save-session-functions) + (error t)))) + +(defun handle-save-session (_event) + "SKIP: real doc in xsmfns.c." + (interactive "e") + (let ((cancel-shutdown t)) + (unwind-protect + (setq cancel-shutdown (emacs-session-save)) + (haiku-save-session-reply (not cancel-shutdown))) + ;; The App Server will kill Emacs after receiving the reply, but + ;; the Deskbar will not, so kill ourself here. + (unless cancel-shutdown (kill-emacs)))) + (provide 'haiku-win) (provide 'term/haiku-win) diff --git a/lisp/term/ns-win.el b/lisp/term/ns-win.el index 065ca235b40..6a414d83f18 100644 --- a/lisp/term/ns-win.el +++ b/lisp/term/ns-win.el @@ -176,7 +176,6 @@ The properties returned may include `top', `left', `height', and `width'." (define-key global-map [ns-power-off] 'save-buffers-kill-emacs) (define-key global-map [ns-open-file] 'ns-find-file) (define-key global-map [ns-open-temp-file] [ns-open-file]) -(define-key global-map [ns-change-font] 'ns-respond-to-change-font) (define-key global-map [ns-open-file-line] 'ns-open-file-select-line) (define-key global-map [ns-spi-service-call] 'ns-spi-service-call) (define-key global-map [ns-new-frame] 'make-frame) @@ -623,34 +622,6 @@ If FRAME is nil, the change applies to the selected frame." ;; Needed for font listing functions under both backend and normal (setq scalable-fonts-allowed t) -;; Set to use font panel instead -(declare-function ns-popup-font-panel "nsfns.m" (&optional frame)) -(defalias 'x-select-font 'ns-popup-font-panel "Pop up the font panel. -This function has been overloaded in Nextstep.") -(defalias 'mouse-set-font 'ns-popup-font-panel "Pop up the font panel. -This function has been overloaded in Nextstep.") - -;; nsterm.m -(defvar ns-input-font) -(defvar ns-input-fontsize) - -(defun ns-respond-to-change-font () - "Set the font chosen in the font-picker panel. -Respond to changeFont: event, expecting ns-input-font and -ns-input-fontsize of new font." - (interactive) - (let ((face 'default)) - (set-face-attribute face t - :family ns-input-font - :height (* 10 ns-input-fontsize)) - (set-face-attribute face (selected-frame) - :family ns-input-font - :height (* 10 ns-input-fontsize)) - (let ((spec (list (list t (face-attr-construct 'default))))) - (put face 'customized-face spec) - (custom-push-theme 'theme-face face 'user 'set spec) - (put face 'face-modified nil)))) - ;; Default fontset for macOS. This is mainly here to show how a fontset ;; can be set up manually. Ordinarily, fontsets are auto-created whenever ;; a font is chosen by diff --git a/lisp/term/x-win.el b/lisp/term/x-win.el index 4c6fcc904c0..ca38a0a8c92 100644 --- a/lisp/term/x-win.el +++ b/lisp/term/x-win.el @@ -109,14 +109,6 @@ (setq x-session-previous-id (car x-invocation-args) x-invocation-args (cdr x-invocation-args))) -(defvar emacs-save-session-functions nil - "Special hook run when a save-session event occurs. -The functions do not get any argument. -Functions can return non-nil to inform the session manager that the -window system shutdown should be aborted. - -See also `emacs-session-save'.") - (defun emacs-session-filename (session-id) "Construct a filename to save the session in based on SESSION-ID. Return a filename in `user-emacs-directory', unless the session file diff --git a/lisp/textmodes/artist.el b/lisp/textmodes/artist.el index e37b0d988ab..686d5f494c9 100644 --- a/lisp/textmodes/artist.el +++ b/lisp/textmodes/artist.el @@ -1371,8 +1371,11 @@ Keymap summary (t ;; Turn mode on (artist-mode-init) - (let ((font (face-attribute 'default :font))) - (when (and (fontp font) (not (font-get font :spacing))) + (let* ((font (face-attribute 'default :font)) + (spacing-prop (if (fontp font) + (font-get font :spacing) + t))) + (when (or (null spacing-prop) (eq spacing-prop 0)) (message "The default font isn't monospaced, so the drawings in this buffer may look odd")))))) ;; Init and exit diff --git a/lisp/textmodes/bibtex.el b/lisp/textmodes/bibtex.el index d02eca506a8..62a4af13774 100644 --- a/lisp/textmodes/bibtex.el +++ b/lisp/textmodes/bibtex.el @@ -2298,11 +2298,17 @@ is non-nil, FUN is not called for @String entries." (set-marker-insertion-type end-marker t) (save-excursion (goto-char (point-min)) - (while (setq found (bibtex-skip-to-valid-entry)) - (set-marker end-marker (cdr found)) - (looking-at bibtex-any-entry-maybe-empty-head) - (funcall fun (bibtex-key-in-head "") (car found) end-marker) - (goto-char end-marker))))) + (let ((prev (point))) + (while (setq found (bibtex-skip-to-valid-entry)) + ;; If we have invalid entries, ensure that we have forward + ;; progress so that we don't infloop. + (if (= (point) prev) + (forward-line 1) + (setq prev (point)) + (set-marker end-marker (cdr found)) + (looking-at bibtex-any-entry-maybe-empty-head) + (funcall fun (bibtex-key-in-head "") (car found) end-marker) + (goto-char end-marker))))))) (defun bibtex-progress-message (&optional flag interval) "Echo a message about progress of current buffer. @@ -5033,7 +5039,7 @@ on the value of `bibtex-entry-format'. If the reference key of the entry is empty or a prefix argument is given, calculate a new reference key. (Note: this works only if fields in entry begin on separate lines prior to calling `bibtex-clean-entry' or if -'realign is contained in `bibtex-entry-format'.) +`realign' is contained in `bibtex-entry-format'.) Don't call `bibtex-clean-entry' on @Preamble entries. At end of the cleaning process, the functions in `bibtex-clean-entry-hook' are called with region narrowed to entry." diff --git a/lisp/textmodes/emacs-news-mode.el b/lisp/textmodes/emacs-news-mode.el new file mode 100644 index 00000000000..fdb3cb86284 --- /dev/null +++ b/lisp/textmodes/emacs-news-mode.el @@ -0,0 +1,224 @@ +;;; emacs-news-mode.el --- major mode to edit and view the NEWS file -*- lexical-binding: t; -*- + +;; Copyright (C) 2022 Free Software Foundation, Inc. + +;; Keywords: tools + +;; 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: + +(eval-when-compile (require 'cl-lib)) + +(defgroup emacs-news-mode nil + "Major mode for editing and viewing the Emacs NEWS file." + :group 'lisp) + +(defface emacs-news-is-documented + '((t :inherit font-lock-type-face)) + "Face used for displaying the \"is documented\" tag." + :version "29.1") + +(defface emacs-news-does-not-need-documentation + '((t :inherit font-lock-preprocessor-face)) + "Face used for displaying the \"does not need documentation\" tag." + :version "29.1") + +(defvar-keymap emacs-news-mode-map + "C-c C-s" #'emacs-news-next-untagged-entry + "C-c C-r" #'emacs-news-previous-untagged-entry + "C-c C-g" #'emacs-news-goto-section + "C-c C-f" #'emacs-news-find-heading + "C-c C-n" #'emacs-news-count-untagged-entries) + +(defvar emacs-news-mode-font-lock-keywords + `(("^---$" 0 'emacs-news-does-not-need-documentation) + ("^\\+\\+\\+$" 0 'emacs-news-is-documented))) + +(defun emacs-news--mode-common () + (setq-local font-lock-defaults '(emacs-news-mode-font-lock-keywords t)) + (setq-local outline-regexp "\\*+ " + outline-minor-mode-cycle t + ;; We subtract one from the level, because we have a + ;; space after the asterisks. + outline-level (lambda () (1- (length (match-string 0)))) + outline-minor-mode-highlight 'append) + (outline-minor-mode)) + +;;;###autoload +(define-derived-mode emacs-news-mode text-mode "NEWS" + "Major mode for editing the Emacs NEWS file." + (setq-local fill-paragraph-function #'emacs-news--fill-paragraph) + (emacs-news--mode-common)) + +;;;###autoload +(define-derived-mode emacs-news-view-mode special-mode "NEWS" + "Major mode for viewing the Emacs NEWS file." + (setq buffer-read-only t) + (emacs-news--buttonize) + (button-mode) + (emacs-news--mode-common)) + +(defun emacs-news--fill-paragraph (&optional justify) + (cond + ;; We're in a heading -- do nothing. + ((save-excursion + (beginning-of-line) + (looking-at "\\*+ ")) + ) + ;; We're in a news item -- exclude the heading before filling. + ((and (save-excursion + (re-search-backward (concat "^\\(?:" paragraph-start "\\|\\*+ \\)") + nil t)) + (= (char-after (match-beginning 0)) ?*)) + (save-restriction + (narrow-to-region (save-excursion + (goto-char (match-beginning 0)) + (forward-line 1) + (point)) + (point-max)) + (fill-paragraph justify))) + ;; Fill normally. + (t + (fill-paragraph justify)))) + +(defun emacs-news-next-untagged-entry (&optional reverse) + "Go to the next untagged NEWS entry. +If REVERSE (interactively, the prefix), go to the previous +untagged NEWS entry." + (interactive "P" emacs-news-mode) + (let ((start (point)) + (found nil)) + ;; Don't consider the current line, because that would stop + ;; progress if calling this command repeatedly. + (unless reverse + (forward-line 1)) + (while (and (not found) + (funcall (if reverse #'re-search-backward + #'re-search-forward) + "^\\(\\*+\\) " nil t)) + (when (and (not (save-excursion + (forward-line -1) + (looking-at "---$\\|\\+\\+\\+$"))) + ;; We have an entry without a tag before it, but + ;; check whether it's a heading (which we can + ;; determine if the next entry has more asterisks). + (not (emacs-news--heading-p))) + ;; It wasn't a sub-heading, so we've found one. + (setq found t))) + (if found + (progn + (push-mark start) + (message "Untagged entry") + (beginning-of-line) + t) + (message "No further untagged entries") + (goto-char start) + nil))) + +(defun emacs-news--heading-p () + (save-excursion + (beginning-of-line) + ;; A heading starts with * characters, and then a blank line, and + ;; then paragraphs with more * characters than in the heading. + (and (looking-at "\\(\\*+\\) ") + (let ((level (length (match-string 1)))) + (forward-line 1) + (and (looking-at "$") + (re-search-forward "^\\(\\*+\\) " nil t) + (> (length (match-string 1)) level)))))) + +(defun emacs-news-previous-untagged-entry () + "Go to the previous untagged NEWS entry." + (interactive nil emacs-news-mode) + (emacs-news-next-untagged-entry t)) + +(defun emacs-news-count-untagged-entries () + "Say how many untagged entries there are in the current NEWS buffer." + (interactive nil emacs-news-mode) + (save-excursion + (goto-char (point-min)) + (let ((i 0)) + (while (emacs-news-next-untagged-entry) + (setq i (1+ i))) + (message (if (= i 1) + "There's 1 untagged entry" + (format "There are %s untagged entries" i)))))) + +(defun emacs-news--buttonize () + "Make manual and symbol references into buttons." + (save-excursion + (with-silent-modifications + (let ((inhibit-read-only t)) + ;; Do functions and variables. + (goto-char (point-min)) + (search-forward "\f" nil t) + (while (re-search-forward "'\\([^-][^ \t\n]+\\)'" nil t) + ;; Filter out references to key sequences. + (let ((string (match-string 1))) + (when-let ((symbol (intern-soft string))) + (when (or (boundp symbol) + (fboundp symbol)) + (buttonize-region (match-beginning 1) (match-end 1) + (lambda (symbol) + (describe-symbol symbol)) + symbol))))) + ;; Do manual references. + (goto-char (point-min)) + (search-forward "\f" nil t) + (while (re-search-forward "\"\\(([a-z0-9]+)[ \n][^\"]\\{1,80\\}\\)\"" + nil t) + (buttonize-region (match-beginning 1) (match-end 1) + (lambda (node) (info node)) + (match-string 1))))))) + +(defun emacs-news--sections (regexp) + (let ((sections nil)) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward (concat "^" regexp "\\(.*\\)") nil t) + (when (save-match-data (emacs-news--heading-p)) + (push (buffer-substring-no-properties + (match-beginning 1) (match-end 1)) + sections)))) + (nreverse sections))) + +(defun emacs-news-goto-section (section) + "Go to SECTION in the Emacs NEWS file." + (interactive (list + (completing-read "Goto section: " (emacs-news--sections "\\* ") + nil t)) + emacs-news-mode) + (goto-char (point-min)) + (when (search-forward (concat "\n* " section) nil t) + (beginning-of-line))) + +(defun emacs-news-find-heading (heading) + "Go to HEADING in the Emacs NEWS file." + (interactive (list + (completing-read "Goto heading: " + (emacs-news--sections "\\*\\*\\*? ") + nil t)) + emacs-news-mode) + (goto-char (point-min)) + (when (re-search-forward (concat "^*+ " (regexp-quote heading)) nil t) + (beginning-of-line))) + +(provide 'emacs-news-mode) + +;;; emacs-news-mode.el ends here diff --git a/lisp/textmodes/fill.el b/lisp/textmodes/fill.el index d3c832a40da..88a8395c88a 100644 --- a/lisp/textmodes/fill.el +++ b/lisp/textmodes/fill.el @@ -29,6 +29,8 @@ ;;; Code: +(eval-when-compile (require 'subr-x)) + (defgroup fill nil "Indenting and filling text." :link '(custom-manual "(emacs)Filling") @@ -839,75 +841,67 @@ region, instead of just filling the current paragraph." (interactive (progn (barf-if-buffer-read-only) (list (if current-prefix-arg 'full) t))) - (let ((hash (and (not (buffer-modified-p)) - (buffer-hash)))) - (prog1 - (or - ;; 1. Fill the region if it is active when called interactively. - (and region transient-mark-mode mark-active - (not (eq (region-beginning) (region-end))) - (or (fill-region (region-beginning) (region-end) justify) t)) - ;; 2. Try fill-paragraph-function. - (and (not (eq fill-paragraph-function t)) - (or fill-paragraph-function - (and (minibufferp (current-buffer)) - (= 1 (point-min)))) - (let ((function (or fill-paragraph-function - ;; In the minibuffer, don't count - ;; the width of the prompt. - 'fill-minibuffer-function)) - ;; If fill-paragraph-function is set, it probably - ;; takes care of comments and stuff. If not, it - ;; will have to set fill-paragraph-handle-comment - ;; back to t explicitly or return nil. - (fill-paragraph-handle-comment nil) - (fill-paragraph-function t)) - (funcall function justify))) - ;; 3. Try our syntax-aware filling code. - (and fill-paragraph-handle-comment - ;; Our code only handles \n-terminated comments right now. - comment-start (equal comment-end "") - (let ((fill-paragraph-handle-comment nil)) - (fill-comment-paragraph justify))) - ;; 4. If it all fails, default to the good ol' text paragraph filling. - (let ((before (point)) - (paragraph-start paragraph-start) - ;; Fill prefix used for filling the paragraph. - fill-pfx) - ;; Try to prevent code sections and comment sections from being - ;; filled together. - (when (and fill-paragraph-handle-comment comment-start-skip) - (setq paragraph-start - (concat paragraph-start "\\|[ \t]*\\(?:" - comment-start-skip "\\)"))) - (save-excursion - ;; To make sure the return value of forward-paragraph is - ;; meaningful, we have to start from the beginning of - ;; line, otherwise skipping past the last few chars of a - ;; paragraph-separator would count as a paragraph (and - ;; not skipping any chars at EOB would not count as a - ;; paragraph even if it is). - (move-to-left-margin) - (if (not (zerop (fill-forward-paragraph 1))) - ;; There's no paragraph at or after point: give up. - (setq fill-pfx "") - (let ((end (point)) - (beg (progn (fill-forward-paragraph -1) (point)))) - (goto-char before) - (setq fill-pfx - (if use-hard-newlines - ;; Can't use fill-region-as-paragraph, since this - ;; paragraph may still contain hard newlines. See - ;; fill-region. - (fill-region beg end justify) - (fill-region-as-paragraph beg end justify)))))) - fill-pfx)) - ;; If we didn't change anything in the buffer (and the buffer - ;; was previously unmodified), then flip the modification status - ;; back to "unchanged". - (when (and hash - (equal hash (buffer-hash))) - (set-buffer-modified-p nil))))) + (with-buffer-unmodified-if-unchanged + (or + ;; 1. Fill the region if it is active when called interactively. + (and region transient-mark-mode mark-active + (not (eq (region-beginning) (region-end))) + (or (fill-region (region-beginning) (region-end) justify) t)) + ;; 2. Try fill-paragraph-function. + (and (not (eq fill-paragraph-function t)) + (or fill-paragraph-function + (and (minibufferp (current-buffer)) + (= 1 (point-min)))) + (let ((function (or fill-paragraph-function + ;; In the minibuffer, don't count + ;; the width of the prompt. + 'fill-minibuffer-function)) + ;; If fill-paragraph-function is set, it probably + ;; takes care of comments and stuff. If not, it + ;; will have to set fill-paragraph-handle-comment + ;; back to t explicitly or return nil. + (fill-paragraph-handle-comment nil) + (fill-paragraph-function t)) + (funcall function justify))) + ;; 3. Try our syntax-aware filling code. + (and fill-paragraph-handle-comment + ;; Our code only handles \n-terminated comments right now. + comment-start (equal comment-end "") + (let ((fill-paragraph-handle-comment nil)) + (fill-comment-paragraph justify))) + ;; 4. If it all fails, default to the good ol' text paragraph filling. + (let ((before (point)) + (paragraph-start paragraph-start) + ;; Fill prefix used for filling the paragraph. + fill-pfx) + ;; Try to prevent code sections and comment sections from being + ;; filled together. + (when (and fill-paragraph-handle-comment comment-start-skip) + (setq paragraph-start + (concat paragraph-start "\\|[ \t]*\\(?:" + comment-start-skip "\\)"))) + (save-excursion + ;; To make sure the return value of forward-paragraph is + ;; meaningful, we have to start from the beginning of + ;; line, otherwise skipping past the last few chars of a + ;; paragraph-separator would count as a paragraph (and + ;; not skipping any chars at EOB would not count as a + ;; paragraph even if it is). + (move-to-left-margin) + (if (not (zerop (fill-forward-paragraph 1))) + ;; There's no paragraph at or after point: give up. + (setq fill-pfx "") + (let ((end (point)) + (beg (progn (fill-forward-paragraph -1) (point)))) + (goto-char before) + (setq fill-pfx + (if use-hard-newlines + ;; Can't use fill-region-as-paragraph, since this + ;; paragraph may still contain hard newlines. See + ;; fill-region. + (fill-region beg end justify) + (fill-region-as-paragraph beg end justify)))))) + fill-pfx)))) (declare-function comment-search-forward "newcomment" (limit &optional noerror)) (declare-function comment-string-strip "newcomment" (str beforep afterp)) diff --git a/lisp/textmodes/page.el b/lisp/textmodes/page.el index 3fc18323349..5d6f017eb99 100644 --- a/lisp/textmodes/page.el +++ b/lisp/textmodes/page.el @@ -35,11 +35,18 @@ A page boundary is any line whose beginning matches the regexp (interactive "p") (or count (setq count 1)) (while (and (> count 0) (not (eobp))) - ;; In case the page-delimiter matches the null string, - ;; don't find a match without moving. - (if (bolp) (forward-char 1)) - (unless (re-search-forward page-delimiter nil t) - (goto-char (point-max))) + (if (and (looking-at page-delimiter) + (> (match-end 0) (point))) + ;; If we're standing at the page delimiter, then just skip to + ;; the end of it. (But only if it's not a zero-length + ;; delimiter, because then we wouldn't have forward progress.) + (goto-char (match-end 0)) + ;; In case the page-delimiter matches the null string, + ;; don't find a match without moving. + (when (bolp) + (forward-char 1)) + (unless (re-search-forward page-delimiter nil t) + (goto-char (point-max)))) (setq count (1- count))) (while (and (< count 0) (not (bobp))) ;; In case the page-delimiter matches the null string, diff --git a/lisp/textmodes/reftex-global.el b/lisp/textmodes/reftex-global.el index 2dbb4484a71..062cea9c505 100644 --- a/lisp/textmodes/reftex-global.el +++ b/lisp/textmodes/reftex-global.el @@ -88,6 +88,12 @@ No active TAGS table is required." (defun reftex-query-replace-document (&optional from to delimited) "Do `query-replace-regexp' of FROM with TO over the entire document. Third arg DELIMITED (prefix arg) means replace only word-delimited matches. + +As each match is found, the user must type a character saying +what to do with it. Type SPC or `y' to replace the match, +DEL or `n' to skip and go to the next match. For more directions, +type \\[help-command] at that time. + If you exit (\\[keyboard-quit], RET or q), you can resume the query replace with the command \\[tags-loop-continue]. No active TAGS table is required." diff --git a/lisp/textmodes/reftex-parse.el b/lisp/textmodes/reftex-parse.el index 016c9cf3990..49cef297882 100644 --- a/lisp/textmodes/reftex-parse.el +++ b/lisp/textmodes/reftex-parse.el @@ -370,13 +370,18 @@ of master file." docstruct)) (defun reftex-using-biblatex-p () - "Return non-nil if we are using biblatex rather than bibtex." + "Return non-nil if we are using biblatex or other specific cite package. +biblatex and other similar packages like multibib allow multiple macro +calls to load a bibliography file. This function should be able to +detect those packages." (if (boundp 'TeX-active-styles) ;; the sophisticated AUCTeX way - (member "biblatex" TeX-active-styles) + (or (member "biblatex" TeX-active-styles) + (member "multibib" TeX-active-styles)) ;; poor-man's check... (save-excursion - (re-search-forward "^[^%\n]*?\\\\usepackage.*{biblatex}" nil t)))) + (re-search-forward + "^[^%\n]*?\\\\usepackage\\(\\[[^]]*\\]\\)?{biblatex\\|multibib}" nil t)))) ;;;###autoload (defun reftex-locate-bibliography-files (master-dir &optional files) @@ -384,7 +389,7 @@ of master file." (unless files (save-excursion (goto-char (point-min)) - ;; when biblatex is used, multiple \bibliography or + ;; when biblatex or multibib are used, multiple \bibliography or ;; \addbibresource macros are allowed. With plain bibtex, only ;; the first is used. (let ((using-biblatex (reftex-using-biblatex-p)) @@ -392,7 +397,7 @@ of master file." (while (and again (re-search-forward (concat - ;; "\\(\\`\\|[\n\r]\\)[^%]*\\\\\\(" + ;; "\\(\\`\\|[\n\r]\\)[^%]*\\\\\\(" "\\(^\\)[^%\n\r]*\\\\\\(" (mapconcat #'identity reftex-bibliography-commands "\\|") "\\)\\(\\[.+?\\]\\)?{[ \t]*\\([^}]+\\)") @@ -415,7 +420,7 @@ of master file." ;; find the file (reftex-locate-file x "bib" master-dir))) files)) - (delq nil files))) + (delq nil (delete-dups files)))) (defun reftex-replace-label-list-segment (old insert &optional entirely) "Replace the segment in OLD which corresponds to INSERT. diff --git a/lisp/textmodes/rst.el b/lisp/textmodes/rst.el index 9d3e9effe6e..6a91cef1d94 100644 --- a/lisp/textmodes/rst.el +++ b/lisp/textmodes/rst.el @@ -2351,7 +2351,7 @@ If user selects bullets or #, it's just added with position arranged by `rst-insert-list-new-tag'. If user selects enumerations, a further prompt is given. User need to -input a starting item, for example 'e' for 'A)' style. The position is +input a starting item, for example `e' for `A)' style. The position is also arranged by `rst-insert-list-new-tag'." (let* ((itemstyle (completing-read (format-prompt "Select preferred item style" "#.") diff --git a/lisp/textmodes/string-edit.el b/lisp/textmodes/string-edit.el new file mode 100644 index 00000000000..ab0b3b3bd7c --- /dev/null +++ b/lisp/textmodes/string-edit.el @@ -0,0 +1,129 @@ +;;; string-edit.el --- editing long strings -*- lexical-binding: t; -*- + +;; Copyright (C) 2022 Free Software Foundation, Inc. + +;; Maintainer: emacs-devel@gnu.org + +;; 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) + +(defface string-edit-prompt + '((t (:inherit font-lock-comment-face))) + "Face used on `string-edit' help text." + :group 'text + :version "29.1") + +(defvar string-edit--success-callback) +(defvar string-edit--abort-callback) + +;;;###autoload +(cl-defun string-edit (prompt string success-callback + &key abort-callback) + "Switch to a new buffer to edit STRING. +When the user finishes editing (with \\<string-edit-mode-map>\\[string-edit-done]), SUCCESS-CALLBACK +is called with the resulting string. + +If the user aborts (with \\<string-edit-mode-map>\\[string-edit-abort]), ABORT-CALLBACK (if any) is +called with no parameters. + +PROMPT will be inserted at the start of the buffer, but won't be +included in the resulting string. If PROMPT is nil, no help text +will be inserted." + (pop-to-buffer-same-window (generate-new-buffer "*edit string*")) + (when prompt + (let ((inhibit-read-only t)) + (insert prompt) + (ensure-empty-lines 0) + (add-text-properties (point-min) (point) + (list 'intangible t + 'face 'string-edit-prompt + 'read-only t)) + (insert (propertize (make-separator-line) 'rear-nonsticky t)) + (add-text-properties (point-min) (point) + (list 'string-edit--prompt t)))) + (let ((start (point))) + (insert string) + (goto-char start)) + (set-buffer-modified-p nil) + (setq buffer-undo-list nil) + (string-edit-mode) + (setq-local string-edit--success-callback success-callback) + (when abort-callback + (setq-local string-edit--abort-callback abort-callback)) + (setq-local header-line-format + (substitute-command-keys + "Type \\<string-edit-mode-map>\\[string-edit-done] when you've finished editing or \\[string-edit-abort] to abort")) + (message "%s" (substitute-command-keys + "Type \\<string-edit-mode-map>\\[string-edit-done] when you've finished editing"))) + +;;;###autoload +(defun read-string-from-buffer (prompt string) + "Switch to a new buffer to edit STRING in a recursive edit. +The user finishes editing with \\<string-edit-mode-map>\\[string-edit-done], or aborts with \\<string-edit-mode-map>\\[string-edit-abort]). + +PROMPT will be inserted at the start of the buffer, but won't be +included in the resulting string. If nil, no prompt will be +inserted in the buffer." + (string-edit + prompt + string + (lambda (edited) + (setq string edited) + (exit-recursive-edit)) + :abort-callback (lambda () + (exit-recursive-edit) + (error "Aborted edit"))) + (recursive-edit) + string) + +(defvar-keymap string-edit-mode-map + "C-c C-c" #'string-edit-done + "C-c C-k" #'string-edit-abort) + +(define-derived-mode string-edit-mode text-mode "String" + "Mode for editing strings." + :interactive nil) + +(defun string-edit-done () + "Finish editing the string and call the callback function. +This will kill the current buffer." + (interactive) + (goto-char (point-min)) + ;; Skip past the help text. + (when-let ((match (text-property-search-forward + 'string-edit--prompt nil t))) + (goto-char (prop-match-beginning match))) + (let ((string (buffer-substring (point) (point-max))) + (callback string-edit--success-callback)) + (kill-buffer (current-buffer)) + (funcall callback string))) + +(defun string-edit-abort () + "Abort editing the current string." + (interactive) + (let ((callback string-edit--abort-callback)) + (kill-buffer (current-buffer)) + (when callback + (funcall callback)))) + +(provide 'string-edit) + +;;; string-edit.el ends here diff --git a/lisp/textmodes/texinfo.el b/lisp/textmodes/texinfo.el index 7f6ed3d1da9..71b8d82ed96 100644 --- a/lisp/textmodes/texinfo.el +++ b/lisp/textmodes/texinfo.el @@ -31,6 +31,16 @@ ;;; Code: +(eval-when-compile (require 'cl-lib) + (require 'flymake) + (require 'rx)) +(declare-function flymake-diag-region "flymake" + (buffer line &optional col)) +(declare-function flymake-make-diagnostic "flymake" + ( locus beg end type text + &optional data overlay-properties)) +(declare-function flymake--log-1 (level sublog msg &rest args)) + (eval-when-compile (require 'tex-mode)) (declare-function tex-buffer "tex-mode" ()) (declare-function tex-region "tex-mode" (beg end)) @@ -335,6 +345,69 @@ Subexpression 1 is what goes into the corresponding `@end' statement.") (if (re-search-backward "^@node[ \t]+\\([^,\n]+\\)" nil t) (match-string-no-properties 1)))) +;;; Flymake support +(defvar-local texinfo--flymake-proc nil) +(defun texinfo-flymake (report-fn &rest _) + "Texinfo checking for Flymake. + +REPORT-FN is the callback function." + (let ((executable (or (executable-find "makeinfo") + (executable-find "texi2any"))) + (source (current-buffer))) + + (unless executable + (error "Flymake for Texinfo requires `makeinfo' or `texi2any'")) + + (when (process-live-p texinfo--flymake-proc) + (kill-process texinfo--flymake-proc)) + + (save-restriction + (widen) + (setq texinfo--flymake-proc + (make-process + :name "texinfo-flymake" + :noquery t + :connection-type 'pipe + :buffer (generate-new-buffer " *texinfo-flymake*") + :command `(,executable "-o" ,null-device "-") + :sentinel + (lambda (proc _event) + (when (memq (process-status proc) '(exit signal)) + (unwind-protect + (if (eq (buffer-local-value 'texinfo--flymake-proc + source) + proc) + (with-current-buffer (process-buffer proc) + (goto-char (point-min)) + (cl-loop + while (search-forward-regexp + (rx line-start + "-:" + (group-n 1 (0+ digit)) ; Line + (optional ":" (group-n 2 (0+ digit))) ; col + ": " + (optional (group-n 3 "warning: ")) ; warn + (group-n 4 (0+ nonl)) ; Message + line-end) + nil t) + for msg = (match-string 4) + for (beg . end) = (flymake-diag-region + source + (string-to-number (match-string 1))) + for type = (if (match-string 3) + :warning + :error) + collect (flymake-make-diagnostic + source beg end type msg) + into diags + finally (funcall report-fn diags))) + (flymake-log :warning "Cancelling obsolete check %s" + proc)) + (kill-buffer (process-buffer proc))))))) + (process-send-region texinfo--flymake-proc (point-min) (point-max)) + (process-send-eof texinfo--flymake-proc)))) + + ;;; Texinfo mode ;;;###autoload @@ -454,7 +527,10 @@ value of `texinfo-mode-hook'." (let ((prevent-filling "^@\\(def\\|multitable\\)")) (if (null auto-fill-inhibit-regexp) prevent-filling - (concat auto-fill-inhibit-regexp "\\|" prevent-filling))))) + (concat auto-fill-inhibit-regexp "\\|" prevent-filling)))) + + ;; Set up Flymake support. + (add-hook 'flymake-diagnostic-functions #'texinfo-flymake nil t)) (defvar texinfo-fillable-commands '("@noindent") "A list of commands that can be filled.") diff --git a/lisp/textmodes/word-wrap-mode.el b/lisp/textmodes/word-wrap-mode.el new file mode 100644 index 00000000000..1459a3395ca --- /dev/null +++ b/lisp/textmodes/word-wrap-mode.el @@ -0,0 +1,91 @@ +;;; word-wrap-mode.el --- minor mode for `word-wrap' tweaks -*- lexical-binding: t; -*- + +;; Copyright (C) 2022 Free Software Foundation, Inc. + +;; Maintainer: emacs-devel@gnu.org + +;; 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: + +;; The list below lists all characters that have a general-category of +;; Zs, but with the ones we don't want to add here commented out. +(defcustom word-wrap-whitespace-characters + '(;;?\N{SPACE} + ;;?\N{NO-BREAK SPACE} + ?\N{OGHAM SPACE MARK} + ?\N{EN QUAD} + ?\N{EM QUAD} + ?\N{EN SPACE} + ?\N{EM SPACE} + ?\N{THREE-PER-EM SPACE} + ?\N{FOUR-PER-EM SPACE} + ?\N{SIX-PER-EM SPACE} + ?\N{FIGURE SPACE} + ?\N{PUNCTUATION SPACE} + ?\N{THIN SPACE} + ?\N{HAIR SPACE} + ;;?\N{NARROW NO-BREAK SPACE} + ?\N{MEDIUM MATHEMATICAL SPACE} + ?\N{IDEOGRAPHIC SPACE} + ;; Not in the Zs category: + ?\N{ZERO WIDTH SPACE}) + "Characters that `word-wrap-whitespace-mode' should add to `word-wrap'." + :version "29.1" + :type '(repeat character) + :group 'display) + +(defvar word-wrap-mode--previous-state) + +;;;###autoload +(define-minor-mode word-wrap-whitespace-mode + "Allow `word-wrap' to fold on all breaking whitespace characters. +The characters to break on are defined by `word-wrap-whitespace-characters'." + :group 'display + (if word-wrap-whitespace-mode + (progn + (setq-local word-wrap-mode--previous-state + (list (category-table) + (local-variable-p 'word-wrap-by-category) + word-wrap-by-category + (local-variable-p 'word-wrap) + word-wrap)) + (set-category-table (copy-category-table)) + (dolist (char word-wrap-whitespace-characters) + (modify-category-entry char ?|)) + (setq-local word-wrap-by-category t + word-wrap t)) + (pcase-let ((`(,table ,lby-cat ,by-cat + ,lwrap ,wrap) + word-wrap-mode--previous-state)) + (if lby-cat + (setq-local word-wrap-by-category by-cat) + (kill-local-variable 'word-wrap-by-category)) + (if lwrap + (setq-local word-wrap wrap) + (kill-local-variable 'word-wrap)) + (set-category-table table)))) + +;;;###autoload +(define-globalized-minor-mode global-word-wrap-whitespace-mode + word-wrap-whitespace-mode word-wrap-whitespace-mode + :group 'display) + +(provide 'word-wrap-mode) + +;;; word-wrap-mode.el ends here diff --git a/lisp/tool-bar.el b/lisp/tool-bar.el index 7ec5c0beccc..82b458e0107 100644 --- a/lisp/tool-bar.el +++ b/lisp/tool-bar.el @@ -89,15 +89,29 @@ functions.") (declare-function image-mask-p "image.c" (spec &optional frame)) -(defconst tool-bar-keymap-cache (make-hash-table :weakness t :test 'equal)) +(defconst tool-bar-keymap-cache (make-hash-table :test #'equal)) + +(defun tool-bar--cache-key () + (cons (frame-terminal) (sxhash-eq tool-bar-map))) + +(defun tool-bar--flush-cache () + "Remove all cached entries that refer to the current `tool-bar-map'." + (let ((id (sxhash-eq tool-bar-map)) + (entries nil)) + (maphash (lambda (k _) + (when (equal (cdr k) id) + (push k entries))) + tool-bar-keymap-cache) + (dolist (k entries) + (remhash k tool-bar-keymap-cache)))) (defun tool-bar-make-keymap (&optional _ignore) "Generate an actual keymap from `tool-bar-map'. Its main job is to figure out which images to use based on the display's color capability and based on the available image libraries." - (let ((key (cons (frame-terminal) tool-bar-map))) - (or (gethash key tool-bar-keymap-cache) - (puthash key (tool-bar-make-keymap-1) tool-bar-keymap-cache)))) + (or (gethash (tool-bar--cache-key) tool-bar-keymap-cache) + (setf (gethash (tool-bar--cache-key) tool-bar-keymap-cache) + (tool-bar-make-keymap-1)))) (defun tool-bar-make-keymap-1 () "Generate an actual keymap from `tool-bar-map', without caching." @@ -139,7 +153,8 @@ ICON.xbm, using `find-image'. Use this function only to make bindings in the global value of `tool-bar-map'. To define items in any other map, use `tool-bar-local-item'." - (apply #'tool-bar-local-item icon def key tool-bar-map props)) + (apply #'tool-bar-local-item icon def key tool-bar-map props) + (tool-bar--flush-cache)) (defun tool-bar--image-expression (icon) "Return an expression that evaluates to an image spec for ICON." @@ -177,6 +192,7 @@ ICON.xbm, using `find-image'." (let* ((image-exp (tool-bar--image-expression icon))) (define-key-after map (vector key) `(menu-item ,(symbol-name key) ,def :image ,image-exp ,@props)) + (tool-bar--flush-cache) (force-mode-line-update))) ;;;###autoload @@ -243,6 +259,7 @@ holds a keymap." (setq rest (cdr rest))) (append `(menu-item ,(car defn) ,rest) (list :image image-exp) props)))) + (tool-bar--flush-cache) (force-mode-line-update)))) ;;; Set up some global items. Additions/deletions up for grabs. diff --git a/lisp/tooltip.el b/lisp/tooltip.el index 0ee3c38e26d..e24d03b8e87 100644 --- a/lisp/tooltip.el +++ b/lisp/tooltip.el @@ -377,7 +377,11 @@ 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)) + (if (and (display-graphic-p) + ;; Tooltips can't be displayed on top of the global menu + ;; bar on NS. + (or (not (eq window-system 'ns)) + (not (menu-or-popup-active-p)))) (let ((previous-help tooltip-help-message)) (setq tooltip-help-message msg) (cond ((null msg) diff --git a/lisp/transient.el b/lisp/transient.el index 0d7f9d0317b..13e8de258bd 100644 --- a/lisp/transient.el +++ b/lisp/transient.el @@ -1384,7 +1384,7 @@ The optional argument COMMAND is intended for internal use. If you are contemplating using it in your own code, then you should probably use this instead: - (get COMMAND 'transient--suffix)" + (get COMMAND \\='transient--suffix)" (when command (cl-check-type command command)) (if (or transient--prefix diff --git a/lisp/tutorial.el b/lisp/tutorial.el index 2d313076e3a..0f3a1506d6b 100644 --- a/lisp/tutorial.el +++ b/lisp/tutorial.el @@ -385,7 +385,7 @@ correspond to what the tutorial says.\n\n") "Find the key bindings used in the tutorial that have changed. Return a list with elements of the form - '(KEY DEF-FUN DEF-FUN-TXT WHERE REMARK QUIET) + (KEY DEF-FUN DEF-FUN-TXT WHERE REMARK QUIET) where diff --git a/lisp/url/url-auth.el b/lisp/url/url-auth.el index dd658b1b68b..53cefb46e4b 100644 --- a/lisp/url/url-auth.el +++ b/lisp/url/url-auth.el @@ -307,8 +307,8 @@ object." (defun url-digest-auth-build-response (key url realm attrs) "Compute authorization string for the given challenge using KEY. -The string looks like 'Digest username=\"John\", realm=\"The -Realm\", ...' +The string looks like \"Digest username=\"John\", realm=\"The +Realm\", ...\" Part of the challenge is already solved in a pre-computed KEY which is list of a realm (or a directory), user name, and hash diff --git a/lisp/url/url-http.el b/lisp/url/url-http.el index daeba17031d..b950a8994fb 100644 --- a/lisp/url/url-http.el +++ b/lisp/url/url-http.el @@ -36,6 +36,7 @@ (defvar url-current-object) (defvar url-http-after-change-function) (defvar url-http-chunked-counter) +(defvar url-http-chunked-last-crlf-missing) (defvar url-http-chunked-length) (defvar url-http-chunked-start) (defvar url-http-connection-opened) @@ -332,7 +333,10 @@ Use `url-http-referer' as the Referer-header (subject to `url-privacy-level')." (if (and using-proxy ;; Bug#35969. (not (equal "https" (url-type url-http-target-url)))) - (url-recreate-url url-http-target-url) real-fname)) + (let ((url (copy-sequence url-http-target-url))) + (setf (url-host url) (puny-encode-domain (url-host url))) + (url-recreate-url url)) + real-fname)) " HTTP/" url-http-version "\r\n" ;; Version of MIME we speak "MIME-Version: 1.0\r\n" @@ -1068,90 +1072,105 @@ the callback to be triggered." Cannot give a sophisticated percentage, but we need a different function to look for the special 0-length chunk that signifies the end of the document." - (save-excursion - (goto-char st) - (let ((read-next-chunk t) - (case-fold-search t) - (regexp nil) - (no-initial-crlf nil)) - ;; We need to loop thru looking for more chunks even within - ;; one after-change-function call. - (while read-next-chunk - (setq no-initial-crlf (= 0 url-http-chunked-counter)) - (if url-http-content-type + (if url-http-chunked-last-crlf-missing + (progn + (goto-char url-http-chunked-last-crlf-missing) + (if (not (looking-at "\r\n")) + (url-http-debug + "Still spinning for the terminator of last chunk...") + (url-http-debug "Saw the last CRLF.") + (delete-region (match-beginning 0) (match-end 0)) + (when (url-http-parse-headers) + (url-http-activate-callback)))) + (save-excursion + (goto-char st) + (let ((read-next-chunk t) + (case-fold-search t) + (regexp nil) + (no-initial-crlf nil)) + ;; We need to loop thru looking for more chunks even within + ;; one after-change-function call. + (while read-next-chunk + (setq no-initial-crlf (= 0 url-http-chunked-counter)) + (if url-http-content-type + (url-display-percentage nil + "Reading [%s]... chunk #%d" + url-http-content-type url-http-chunked-counter) (url-display-percentage nil - "Reading [%s]... chunk #%d" - url-http-content-type url-http-chunked-counter) - (url-display-percentage nil - "Reading... chunk #%d" - url-http-chunked-counter)) - (url-http-debug "Reading chunk %d (%d %d %d)" - url-http-chunked-counter st nd length) - (setq regexp (if no-initial-crlf - "\\([0-9a-z]+\\).*\r?\n" - "\r?\n\\([0-9a-z]+\\).*\r?\n")) - - (if url-http-chunked-start - ;; We know how long the chunk is supposed to be, skip over - ;; leading crap if possible. - (if (> nd (+ url-http-chunked-start url-http-chunked-length)) - (progn - (url-http-debug "Got to the end of chunk #%d!" - url-http-chunked-counter) - (goto-char (+ url-http-chunked-start - url-http-chunked-length))) - (url-http-debug "Still need %d bytes to hit end of chunk" - (- (+ url-http-chunked-start - url-http-chunked-length) - nd)) - (setq read-next-chunk nil))) - (if (not read-next-chunk) - (url-http-debug "Still spinning for next chunk...") - (if no-initial-crlf (skip-chars-forward "\r\n")) - (if (not (looking-at regexp)) - (progn - ;; Must not have received the entirety of the chunk header, - ;; need to spin some more. - (url-http-debug "Did not see start of chunk @ %d!" (point)) - (setq read-next-chunk nil)) - ;; The data we got may have started in the middle of the - ;; initial chunk header, so move back to the start of the - ;; line and re-compute. - (when (= url-http-chunked-counter 0) - (beginning-of-line) - (looking-at regexp)) - (add-text-properties (match-beginning 0) (match-end 0) - (list 'chunked-encoding t - 'face 'cursor - 'invisible t)) - (setq url-http-chunked-length (string-to-number (buffer-substring - (match-beginning 1) - (match-end 1)) - 16) - url-http-chunked-counter (1+ url-http-chunked-counter) - url-http-chunked-start (set-marker - (or url-http-chunked-start - (make-marker)) - (match-end 0))) - (delete-region (match-beginning 0) (match-end 0)) - (url-http-debug "Saw start of chunk %d (length=%d, start=%d" - url-http-chunked-counter url-http-chunked-length - (marker-position url-http-chunked-start)) - (if (= 0 url-http-chunked-length) - (progn - ;; Found the end of the document! Wheee! - (url-http-debug "Saw end of stream chunk!") - (setq read-next-chunk nil) - (url-display-percentage nil nil) - ;; Every chunk, even the last 0-length one, is - ;; terminated by CRLF. Skip it. - (when (looking-at "\r?\n") - (url-http-debug "Removing terminator of last chunk") - (delete-region (match-beginning 0) (match-end 0))) - (if (re-search-forward "^\r?\n" nil t) - (url-http-debug "Saw end of trailers...")) - (if (url-http-parse-headers) - (url-http-activate-callback)))))))))) + "Reading... chunk #%d" + url-http-chunked-counter)) + (url-http-debug "Reading chunk %d (%d %d %d)" + url-http-chunked-counter st nd length) + (setq regexp (if no-initial-crlf + "\\([0-9a-z]+\\).*\r?\n" + "\r?\n\\([0-9a-z]+\\).*\r?\n")) + + (if url-http-chunked-start + ;; We know how long the chunk is supposed to be, skip over + ;; leading crap if possible. + (if (> nd (+ url-http-chunked-start url-http-chunked-length)) + (progn + (url-http-debug "Got to the end of chunk #%d!" + url-http-chunked-counter) + (goto-char (+ url-http-chunked-start + url-http-chunked-length))) + (url-http-debug "Still need %d bytes to hit end of chunk" + (- (+ url-http-chunked-start + url-http-chunked-length) + nd)) + (setq read-next-chunk nil))) + (if (not read-next-chunk) + (url-http-debug "Still spinning for next chunk...") + (if no-initial-crlf (skip-chars-forward "\r\n")) + (if (not (looking-at regexp)) + (progn + ;; Must not have received the entirety of the chunk header, + ;; need to spin some more. + (url-http-debug "Did not see start of chunk @ %d!" (point)) + (setq read-next-chunk nil)) + ;; The data we got may have started in the middle of the + ;; initial chunk header, so move back to the start of the + ;; line and re-compute. + (when (= url-http-chunked-counter 0) + (beginning-of-line) + (looking-at regexp)) + (add-text-properties (match-beginning 0) (match-end 0) + (list 'chunked-encoding t + 'face 'cursor + 'invisible t)) + (setq url-http-chunked-length + (string-to-number (buffer-substring (match-beginning 1) + (match-end 1)) + 16) + url-http-chunked-counter (1+ url-http-chunked-counter) + url-http-chunked-start (set-marker + (or url-http-chunked-start + (make-marker)) + (match-end 0))) + (delete-region (match-beginning 0) (match-end 0)) + (url-http-debug "Saw start of chunk %d (length=%d, start=%d" + url-http-chunked-counter url-http-chunked-length + (marker-position url-http-chunked-start)) + (if (= 0 url-http-chunked-length) + (progn + ;; Found the end of the document! Wheee! + (url-http-debug "Saw end of stream chunk!") + (setq read-next-chunk nil) + (url-display-percentage nil nil) + ;; Every chunk, even the last 0-length one, is + ;; terminated by CRLF. Skip it. + (if (not (looking-at "\r?\n")) + (progn + (url-http-debug + "Spinning for the terminator of last chunk...") + (setq url-http-chunked-last-crlf-missing + (point))) + (url-http-debug "Removing terminator of last chunk") + (delete-region (match-beginning 0) (match-end 0)) + (when (re-search-forward "^\r?\n" nil t) + (url-http-debug "Saw end of trailers...")) + (when (url-http-parse-headers) + (url-http-activate-callback)))))))))))) (defun url-http-wait-for-headers-change-function (_st nd _length) ;; This will wait for the headers to arrive and then splice in the @@ -1335,6 +1354,7 @@ The return value of this function is the retrieval buffer." url-http-after-change-function url-http-response-version url-http-response-status + url-http-chunked-last-crlf-missing url-http-chunked-length url-http-chunked-counter url-http-chunked-start @@ -1359,6 +1379,7 @@ The return value of this function is the retrieval buffer." url-http-noninteractive url-request-noninteractive url-http-data url-request-data url-http-process connection + url-http-chunked-last-crlf-missing nil url-http-chunked-length nil url-http-chunked-start nil url-http-chunked-counter 0 @@ -1405,10 +1426,10 @@ The return value of this function is the retrieval buffer." (and proxy-auth (concat "Proxy-Authorization: " proxy-auth "\r\n"))) "\r\n") - (url-host url-current-object) + (puny-encode-domain (url-host url-current-object)) (or (url-port url-current-object) url-https-default-port) - (url-host url-current-object)))) + (puny-encode-domain (url-host url-current-object))))) (defun url-https-proxy-after-change-function (_st _nd _length) (let* ((process-buffer (current-buffer)) @@ -1430,12 +1451,12 @@ The return value of this function is the retrieval buffer." (condition-case e (let ((tls-connection (gnutls-negotiate :process proc - :hostname (url-host url-current-object) + :hostname (puny-encode-domain (url-host url-current-object)) :verify-error nil))) ;; check certificate validity (setq tls-connection (nsm-verify-connection tls-connection - (url-host url-current-object) + (puny-encode-domain (url-host url-current-object)) (url-port url-current-object))) (with-current-buffer process-buffer (erase-buffer)) (set-process-buffer tls-connection process-buffer) diff --git a/lisp/vc/vc-bzr.el b/lisp/vc/vc-bzr.el index 836630acb5d..ee394a93af4 100644 --- a/lisp/vc/vc-bzr.el +++ b/lisp/vc/vc-bzr.el @@ -640,7 +640,7 @@ Returns nil if unable to find this information." ;; Could run `bzr status' in the directory and see if it succeeds, but ;; that's relatively expensive. (defalias 'vc-bzr-responsible-p #'vc-bzr-root - "Return non-nil if FILE is (potentially) controlled by bzr. + "Return the directory if FILE is (potentially) controlled by bzr. The criterion is that there is a `.bzr' directory in the same or a superior directory.") diff --git a/lisp/vc/vc-cvs.el b/lisp/vc/vc-cvs.el index e234b9a0447..8f06d5a847a 100644 --- a/lisp/vc/vc-cvs.el +++ b/lisp/vc/vc-cvs.el @@ -308,7 +308,7 @@ to the CVS command." (vc-switches 'CVS 'register))) (defun vc-cvs-responsible-p (file) - "Return non-nil if CVS thinks it is responsible for FILE." + "Return the directory if CVS thinks it is responsible for FILE." (let ((dir (if (file-directory-p file) file (file-name-directory file)))) diff --git a/lisp/vc/vc-dav.el b/lisp/vc/vc-dav.el index 61e2cd23900..94621599e4a 100644 --- a/lisp/vc/vc-dav.el +++ b/lisp/vc/vc-dav.el @@ -137,9 +137,9 @@ It should return a status of either 0 (no differences found), or ) (defun vc-dav-responsible-p (url) - "Return non-nil if DAV considers itself `responsible' for URL." + "Return the URL if DAV considers itself `responsible' for URL." ;; Check for DAV support on the web server. - (and t url)) + url) ;;; Unimplemented functions ;; diff --git a/lisp/vc/vc-dir.el b/lisp/vc/vc-dir.el index 0d750515c3d..2e9de587bf9 100644 --- a/lisp/vc/vc-dir.el +++ b/lisp/vc/vc-dir.el @@ -933,6 +933,12 @@ To continue searching for next match, use command \\[tags-loop-continue]." "Do `query-replace-regexp' of FROM with TO, on all marked files. If a directory is marked, then use the files displayed for that directory. Third arg DELIMITED (prefix arg) means replace only word-delimited matches. + +As each match is found, the user must type a character saying +what to do with it. Type SPC or `y' to replace the match, +DEL or `n' to skip and go to the next match. For more directions, +type \\[help-command] at that time. + If you exit (\\[keyboard-quit], RET or q), you can resume the query replace with the command \\[tags-loop-continue]." ;; FIXME: this is almost a copy of `dired-do-query-replace-regexp'. This diff --git a/lisp/vc/vc-rcs.el b/lisp/vc/vc-rcs.el index 20f3b1fba71..170f5c8d464 100644 --- a/lisp/vc/vc-rcs.el +++ b/lisp/vc/vc-rcs.el @@ -288,7 +288,7 @@ to the RCS command." (match-string 1)))))) (defun vc-rcs-responsible-p (file) - "Return non-nil if RCS thinks it would be responsible for registering FILE." + "Return the directory if RCS thinks it would be responsible for FILE." ;; TODO: check for all the patterns in vc-rcs-master-templates (let ((dir (if (file-directory-p file) file @@ -1062,9 +1062,9 @@ file." (defun vc-rcs-consult-headers (file) "Search for RCS headers in FILE, and set properties accordingly. -Returns: nil if no headers were found - 'rev if a workfile revision was found - 'rev-and-lock if revision and lock info was found" +Returns: nil if no headers were found + `rev' if a workfile revision was found + `rev-and-lock' if revision and lock info was found" (cond ((not (get-file-buffer file)) nil) ((let (status version) diff --git a/lisp/vc/vc-sccs.el b/lisp/vc/vc-sccs.el index 4bbf92b3274..1035ee9ce9d 100644 --- a/lisp/vc/vc-sccs.el +++ b/lisp/vc/vc-sccs.el @@ -212,7 +212,7 @@ to the SCCS command." (vc-sccs-do-command nil 0 "get" (vc-master-name file))))) (defun vc-sccs-responsible-p (file) - "Return non-nil if SCCS thinks it would be responsible for registering FILE." + "Return the directory if SCCS thinks it would be responsible for FILE." ;; TODO: check for all the patterns in vc-sccs-master-templates (or (and (file-directory-p (expand-file-name "SCCS" (file-name-directory file))) diff --git a/lisp/vc/vc-src.el b/lisp/vc/vc-src.el index 1c1a7b5d139..5a252c55cb2 100644 --- a/lisp/vc/vc-src.el +++ b/lisp/vc/vc-src.el @@ -242,11 +242,13 @@ This function differs from vc-do-command in that it invokes `vc-src-program'." (vc-src-command nil files "add")) (defun vc-src-responsible-p (file) - "Return non-nil if SRC thinks it would be responsible for registering FILE." - (file-directory-p (expand-file-name ".src" - (if (file-directory-p file) - file - (file-name-directory file))))) + "Return the directory if SRC thinks it would be responsible for FILE." + (let ((dir (expand-file-name ".src" + (if (file-directory-p file) + file + (file-name-directory file))))) + (and (file-directory-p dir) + dir))) (defun vc-src-checkin (files comment &optional _rev) "SRC-specific version of `vc-backend-checkin'. diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index a6124acadd2..3508f684c49 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -220,7 +220,7 @@ ;; ;; - responsible-p (file) ;; -;; Return non-nil if this backend considers itself "responsible" for +;; Return the directory if this backend considers itself "responsible" for ;; FILE, which can also be a directory. This function is used to find ;; out what backend to use for registration of new files and for things ;; like change log generation. The default implementation always diff --git a/lisp/window.el b/lisp/window.el index dd297a31698..9f787846124 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -2496,7 +2496,7 @@ unless DEDICATED is non-nil, so if all windows are dedicated, the value is nil. Avoid returning the selected window if possible. Optional argument NOT-SELECTED non-nil means never return the selected window. Optional argument NO-OTHER non-nil means to -never return a window whose 'no-other-window' parameter is +never return a window whose `no-other-window' parameter is non-nil. The following non-nil values of the optional argument ALL-FRAMES @@ -2538,7 +2538,7 @@ never a candidate unless DEDICATED is non-nil, so if all windows are dedicated, the value is nil. Optional argument NOT-SELECTED non-nil means never return the selected window. Optional argument NO-OTHER non-nil means to never return a window whose -'no-other-window' parameter is non-nil. +`no-other-window' parameter is non-nil. The following non-nil values of the optional argument ALL-FRAMES have special meanings: @@ -2574,7 +2574,7 @@ never a candidate unless DEDICATED is non-nil, so if all windows are dedicated, the value is nil. Optional argument NOT-SELECTED non-nil means never return the selected window. Optional argument NO-OTHER non-nil means to never return a window whose -'no-other-window' parameter is non-nil. +`no-other-window' parameter is non-nil. The following non-nil values of the optional argument ALL-FRAMES have special meanings: @@ -5007,7 +5007,11 @@ minibuffer window or is dedicated to its buffer." BUFFER-OR-NAME may be a buffer or the name of an existing buffer and defaults to the current buffer. -Interactively, prompt for the buffer. +Interactively, this command will prompt for the buffer name. A +prefix argument of 0 (zero) means that only windows in the +current terminal's frames will be deleted. Any other prefix +argument means that only windows in the current frame will be +deleted. The following non-nil values of the optional argument FRAME have special meanings: @@ -5044,7 +5048,21 @@ If the buffer specified by BUFFER-OR-NAME is shown in a minibuffer window, do nothing for that window. For any window that does not show that buffer, remove the buffer from that window's lists of previous and next buffers." - (interactive "bDelete windows on (buffer):\nP") + (interactive + (let ((frame (cond + ((and (numberp current-prefix-arg) + (zerop current-prefix-arg)) + 0) + (current-prefix-arg t)))) + (list (read-buffer "Delete windows on (buffer): " + nil nil + (lambda (buf) + (get-buffer-window + (if (consp buf) (car buf) buf) + (cond + ((null frame) t) + ((numberp frame) frame))))) + frame))) (let ((buffer (window-normalize-buffer buffer-or-name)) ;; Handle the "inverted" meaning of the FRAME argument wrt other ;; `window-list-1' based function. @@ -5117,7 +5135,7 @@ parameter to nil. See Info node `(elisp) Quitting Windows' for more details. If WINDOW's dedicated flag is t, try to delete WINDOW. If it -equals the value 'side', restore that value when WINDOW is not +equals the value `side', restore that value when WINDOW is not deleted. Optional second argument BURY-OR-KILL tells how to proceed with @@ -7440,9 +7458,9 @@ Its value takes effect before processing the ACTION argument of If non-nil, this is an alist of elements (CONDITION . ACTION), where: - CONDITION is either a regexp matching buffer names, or a - function that takes two arguments - a buffer name and the - ACTION argument of `display-buffer' - and returns a boolean. + CONDITION is passed to `buffer-match-p', along with the buffer + that is to be displayed and the ACTION argument of + `display-buffer', to check if ACTION should be used. ACTION is a cons cell (FUNCTIONS . ALIST), where FUNCTIONS is an action function or a list of action functions and ALIST is an @@ -7495,22 +7513,16 @@ all fail. It should never be set by programs or users. See `display-buffer'.") (put 'display-buffer-fallback-action 'risky-local-variable t) -(defun display-buffer-assq-regexp (buffer-name alist action) - "Retrieve ALIST entry corresponding to BUFFER-NAME. -This returns the cdr of the alist entry ALIST if either its key -is a string that matches BUFFER-NAME, as reported by -`string-match-p'; or if the key is a function that returns -non-nil when called with three arguments: the ALIST key, -BUFFER-NAME and ACTION. ACTION should have the form of the -action argument passed to `display-buffer'." +(defun display-buffer-assq-regexp (buffer-or-name alist action) + "Retrieve ALIST entry corresponding to buffer specified by BUFFER-OR-NAME. +This returns the cdr of the alist entry ALIST if the entry's +key (its car) and BUFFER-OR-NAME satisfy `buffer-match-p', using +the key as CONDITION argument of `buffer-match-p'. ACTION should +have the form of the action argument passed to `display-buffer'." (catch 'match (dolist (entry alist) - (let ((key (car entry))) - (when (or (and (stringp key) - (string-match-p key buffer-name)) - (and (functionp key) - (funcall key buffer-name action))) - (throw 'match (cdr entry))))))) + (when (buffer-match-p (car entry) buffer-or-name action) + (throw 'match (cdr entry)))))) (defvar display-buffer--same-window-action '(display-buffer-same-window @@ -7555,7 +7567,7 @@ to an expression containing one of these \"action\" functions: For instance: - (setq display-buffer-alist '((\".*\" display-buffer-at-bottom))) + (setq display-buffer-alist \\='((\".*\" display-buffer-at-bottom))) Buffer display can be further customized to a very high degree; the rest of this docstring explains some of the many @@ -7610,7 +7622,7 @@ Action alist entries are: the window specified in frame lines), a floating point number (the fraction of its total height with respect to the total height of the frame's root window), a cons cell whose - car is 'body-lines' and whose cdr is an integer that + car is `body-lines' and whose cdr is an integer that specifies the height of the window's body in frame lines, or a function to be called with one argument - the chosen window. That function is supposed to adjust the height of @@ -7621,7 +7633,7 @@ Action alist entries are: the window specified in frame lines), a floating point number (the fraction of its total width with respect to the width of the frame's root window), a cons cell whose car is - 'body-columns' and whose cdr is an integer that specifies the + `body-columns' and whose cdr is an integer that specifies the width of the window's body in frame columns, or a function to be called with one argument - the chosen window. That function is supposed to adjust the width of the window. @@ -7629,7 +7641,7 @@ Action alist entries are: alone on their frame and specifies the desired size of that window either as a cons of integers (the total width and height of the window on that frame), a cons cell whose car is - 'body-chars' and whose cdr is a cons of integers (the desired + `body-chars' and whose cdr is a cons of integers (the desired width and height of the window's body in columns and lines of its frame), or a function to be called with one argument - the chosen window. That function is supposed to adjust the @@ -7679,7 +7691,7 @@ specified by the ACTION argument." ;; Otherwise, use the defined actions. (let* ((user-action (display-buffer-assq-regexp - (buffer-name buffer) display-buffer-alist action)) + buffer display-buffer-alist action)) (special-action (display-buffer--special-action buffer)) ;; Extra actions from the arguments to this function: (extra-action @@ -10081,6 +10093,24 @@ If ARG is the atom `-', scroll upward by nearly full screen." (put 'scroll-down-command 'scroll-command t) +(defun scroll-other-window (&optional lines) + "Scroll next window upward LINES lines; or near full screen if no ARG. +See `scroll-up-command' for details." + (interactive "P") + (with-selected-window (other-window-for-scrolling) + (funcall (or (command-remapping #'scroll-up-command) + #'scroll-up-command) + lines))) + +(defun scroll-other-window-down (&optional lines) + "Scroll next window downward LINES lines; or near full screen if no ARG. +See `scroll-down-command' for details." + (interactive "P") + (with-selected-window (other-window-for-scrolling) + (funcall (or (command-remapping #'scroll-down-command) + #'scroll-down-command) + lines))) + ;;; Scrolling commands which scroll a line instead of full screen. (defun scroll-up-line (&optional arg) @@ -10468,6 +10498,55 @@ displaying that processes's buffer." (put 'shrink-window-horizontally 'repeat-map 'resize-window-repeat-map) (put 'shrink-window 'repeat-map 'resize-window-repeat-map) +(defun window-char-pixel-width (&optional window face) + "Return average character width for the font of FACE used in WINDOW. +WINDOW must be a live window and defaults to the selected one. + +If FACE is nil or omitted, the default face is used. If FACE is +remapped (see `face-remapping-alist'), the function returns the +information for the remapped face." + (with-selected-window (window-normalize-window window t) + (let* ((info (font-info (face-font (or face 'default)))) + (width (aref info 11))) + (if (> width 0) + width + (aref info 10))))) + +(defun window-char-pixel-height (&optional window face) + "Return character height for the font of FACE used in WINDOW. +WINDOW must be a live window and defaults to the selected one. + +If FACE is nil or omitted, the default face is used. If FACE is +remapped (see `face-remapping-alist'), the function returns the +information for the remapped face." + (with-selected-window (window-normalize-window window t) + (aref (font-info (face-font (or face 'default))) 3))) + +(defun window-max-characters-per-line (&optional window face) + "Return the number of characters that can be displayed on one line in WINDOW. +WINDOW must be a live window and defaults to the selected one. + +The character width of FACE is used for the calculation. If FACE +is nil or omitted, the default face is used. If FACE is +remapped (see `face-remapping-alist'), the function uses the +remapped face. + +This function is different from `window-body-width' in two +ways. First, it accounts for the portions of the line reserved +for the continuation glyph. Second, it accounts for the size of +the font, which may have been adjusted, e.g., using +`text-scale-increase')." + (with-selected-window (window-normalize-window window t) + (let* ((window-width (window-body-width window t)) + (font-width (window-char-pixel-width window face)) + (ncols (/ window-width font-width))) + (if (and (display-graphic-p) + overflow-newline-into-fringe + (/= (frame-parameter nil 'left-fringe) 0) + (/= (frame-parameter nil 'right-fringe) 0)) + ncols + (1- ncols))))) + (provide 'window) ;;; window.el ends here diff --git a/m4/gnulib-common.m4 b/m4/gnulib-common.m4 index c5ced04f181..30911d1581a 100644 --- a/m4/gnulib-common.m4 +++ b/m4/gnulib-common.m4 @@ -1,4 +1,4 @@ -# gnulib-common.m4 serial 72 +# gnulib-common.m4 serial 73 dnl Copyright (C) 2007-2022 Free Software Foundation, Inc. dnl This file is free software; the Free Software Foundation dnl gives unlimited permission to copy and/or distribute it, @@ -106,6 +106,10 @@ AC_DEFUN([gl_COMMON_BODY], [ #endif #ifdef __has_c_attribute +# if ((defined __STDC_VERSION__ ? __STDC_VERSION__ : 0) <= 201710 \ + && _GL_GNUC_PREREQ (4, 6)) +# pragma GCC diagnostic ignored "-Wpedantic" +# endif # define _GL_HAS_C_ATTRIBUTE(attr) __has_c_attribute (__##attr##__) #else # define _GL_HAS_C_ATTRIBUTE(attr) 0 diff --git a/msdos/sed1v2.inp b/msdos/sed1v2.inp index 4cc733ee79e..b7818f8b21e 100644 --- a/msdos/sed1v2.inp +++ b/msdos/sed1v2.inp @@ -198,6 +198,8 @@ s/ *@WEBP_LIBS@// /^PAXCTL_dumped *=/s/=.*$/=/ /^PAXCTL_notdumped *=/s/=.*$/=/ /^DUMPING *=/s/@DUMPING@/unexec/ +/^[ \t]*MAKE_PDUMPER_FINGERPRINT = *$/c\ +MAKE_PDUMPER_FINGERPRINT = /^lisp\.mk:/,/^$/c\ lisp.mk: $(lispsource)/loadup.el\ @rm -f $@\ @@ -209,6 +211,10 @@ lisp.mk: $(lispsource)/loadup.el\ /^ [ ]*\$(AM_V_at)\$(libsrc)\/make-docfile -d/s!make-docfile!make-docfile -o $(etc)/DOC! / > \$(etc)\/DOC *$/s/ >.*$// +/^\$(etc)\/DOC/,/^$/{ + /^$/i\ + cd ../src +} /^ [ ]*\$(AM_V_GLOBALS)\$(libsrc)\/make-docfile.*>.*globals.tmp/s!make-docfile!make-docfile -o globals.tmp! /^ [ ]*\$(AM_V_GLOBALS)\$(libsrc)\/make-doc/s!>.*$!! /^\$(libsrc)\/make-docfile\$(EXEEXT): /i\ diff --git a/msdos/sedlibmk.inp b/msdos/sedlibmk.inp index 45e03621ce3..302fefe19f0 100644 --- a/msdos/sedlibmk.inp +++ b/msdos/sedlibmk.inp @@ -180,11 +180,14 @@ s/@PACKAGE@/emacs/ /^GL_GNULIB_ENVIRON *=/s/@GL_GNULIB_ENVIRON@/1/ /^GL_GNULIB_FDATASYNC *=/s/@GL_GNULIB_FDATASYNC@/1/ /^GL_GNULIB_GETLOADAVG *=/s/@GL_GNULIB_GETLOADAVG@/1/ +/^GL_GNULIB_GETRANDOM *=/s/@GL_GNULIB_GETRANDOM@/1/ /^GL_GNULIB_UNISTD_H_GETOPT *=/s/@GL_GNULIB_UNISTD_H_GETOPT@/1/ +/^GL_GNULIB_MEMMEM *=/s/@GL_GNULIB_MEMMEM@/1/ /^GL_GNULIB_MEMRCHR *=/s/@GL_GNULIB_MEMRCHR@/1/ /^GL_GNULIB_MEMPCPY *=/s/@GL_GNULIB_MEMPCPY@/1/ /^GL_GNULIB_MKOSTEMP *=/s/@GL_GNULIB_MKOSTEMP@/1/ /^GL_GNULIB_MKTIME *=/s/@GL_GNULIB_MKTIME@/1/ +/^GL_GNULIB_SIGDESCR_NP *=/s/@GL_GNULIB_SIGDESCR_NP@/1/ /^GL_GNULIB_TIME_R *=/s/@GL_GNULIB_TIME_R@/1/ /^GL_GNULIB_TIMEGM *=/s/@GL_GNULIB_TIMEGM@/1/ /^GL_GNULIB_TIME_RZ *=/s/@GL_GNULIB_TIME_RZ@/1/ diff --git a/nt/inc/ms-w32.h b/nt/inc/ms-w32.h index 3f4b2f34892..2dd9a9a476c 100644 --- a/nt/inc/ms-w32.h +++ b/nt/inc/ms-w32.h @@ -295,6 +295,7 @@ extern int sys_unlink (const char *); #undef umask #define umask sys_umask extern int sys_umask (int); +#define clock sys_clock /* Subprocess calls that are emulated. */ #define spawnve sys_spawnve diff --git a/src/alloc.c b/src/alloc.c index 8fd981a51f9..43fbbb79bed 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -6894,7 +6894,7 @@ process_mark_stack (ptrdiff_t base_sp) { set_vector_marked (ptr); struct Lisp_Subr *subr = XSUBR (obj); - mark_stack_push_value (subr->native_intspec); + mark_stack_push_value (subr->intspec.native); mark_stack_push_value (subr->command_modes); mark_stack_push_value (subr->native_comp_u); mark_stack_push_value (subr->lambda_list); @@ -7479,6 +7479,37 @@ arenas. */) } #endif +#ifdef HAVE_MALLOC_TRIM +DEFUN ("malloc-trim", Fmalloc_trim, Smalloc_trim, 0, 1, "", + doc: /* Release free heap memory to the OS. +This function asks libc to return unused heap memory back to the operating +system. This function isn't guaranteed to do anything, and is mainly +meant as a debugging tool. + +If LEAVE_PADDING is given, ask the system to leave that much unused +space in the heap of the Emacs process. This should be an integer, and if +not given, it defaults to 0. + +This function returns nil if no memory could be returned to the +system, and non-nil if some memory could be returned. */) + (Lisp_Object leave_padding) +{ + int pad = 0; + + if (! NILP (leave_padding)) + { + CHECK_FIXNAT (leave_padding); + pad = XFIXNUM (leave_padding); + } + + /* 1 means that memory was released to the system. */ + if (malloc_trim (pad) == 1) + return Qt; + else + return Qnil; +} +#endif + static bool symbol_uses_obj (Lisp_Object symbol, Lisp_Object obj) { @@ -7830,6 +7861,9 @@ N should be nonnegative. */); defsubr (&Smalloc_info); #endif +#ifdef HAVE_MALLOC_TRIM + defsubr (&Smalloc_trim); +#endif defsubr (&Ssuspicious_object); Lisp_Object watcher; @@ -7837,14 +7871,14 @@ N should be nonnegative. */); static union Aligned_Lisp_Subr Swatch_gc_cons_threshold = {{{ PSEUDOVECTOR_FLAG | (PVEC_SUBR << PSEUDOVECTOR_AREA_BITS) }, { .a4 = watch_gc_cons_threshold }, - 4, 4, "watch_gc_cons_threshold", {0}, 0}}; + 4, 4, "watch_gc_cons_threshold", {0}, lisp_h_Qnil}}; XSETSUBR (watcher, &Swatch_gc_cons_threshold.s); Fadd_variable_watcher (Qgc_cons_threshold, watcher); static union Aligned_Lisp_Subr Swatch_gc_cons_percentage = {{{ PSEUDOVECTOR_FLAG | (PVEC_SUBR << PSEUDOVECTOR_AREA_BITS) }, { .a4 = watch_gc_cons_percentage }, - 4, 4, "watch_gc_cons_percentage", {0}, 0}}; + 4, 4, "watch_gc_cons_percentage", {0}, lisp_h_Qnil}}; XSETSUBR (watcher, &Swatch_gc_cons_percentage.s); Fadd_variable_watcher (Qgc_cons_percentage, watcher); } diff --git a/src/bytecode.c b/src/bytecode.c index 62464986160..74b7d16affd 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -325,7 +325,7 @@ If the third argument is incorrect, Emacs may crash. */) the original unibyte form. */ bytestr = Fstring_as_unibyte (bytestr); } - Lisp_Object fun = CALLN (Fmake_byte_code, 0, bytestr, vector, maxdepth); + Lisp_Object fun = CALLN (Fmake_byte_code, Qnil, bytestr, vector, maxdepth); return exec_byte_code (fun, 0, 0, NULL); } diff --git a/src/callint.c b/src/callint.c index 31919d6bb81..92bfaf8d397 100644 --- a/src/callint.c +++ b/src/callint.c @@ -315,7 +315,7 @@ invoke it (via an `interactive' spec that contains, for instance, an Lisp_Object up_event = Qnil; /* Set SPECS to the interactive form, or barf if not interactive. */ - Lisp_Object form = Finteractive_form (function); + Lisp_Object form = call1 (Qinteractive_form, function); if (! CONSP (form)) wrong_type_argument (Qcommandp, function); Lisp_Object specs = Fcar (XCDR (form)); diff --git a/src/comp.c b/src/comp.c index 398f35ddb0b..66a7ab789a8 100644 --- a/src/comp.c +++ b/src/comp.c @@ -5439,7 +5439,7 @@ make_subr (Lisp_Object symbol_name, Lisp_Object minarg, Lisp_Object maxarg, x->s.min_args = XFIXNUM (minarg); x->s.max_args = FIXNUMP (maxarg) ? XFIXNUM (maxarg) : MANY; x->s.symbol_name = xstrdup (SSDATA (symbol_name)); - x->s.native_intspec = intspec; + x->s.intspec.native = intspec; x->s.command_modes = command_modes; x->s.doc = XFIXNUM (doc_idx); #ifdef HAVE_NATIVE_COMP diff --git a/src/data.c b/src/data.c index f06b561dcc6..72dcf6f878d 100644 --- a/src/data.c +++ b/src/data.c @@ -211,6 +211,7 @@ for example, (type-of 1) returns `integer'. */) return Qcons; case Lisp_Vectorlike: + /* WARNING!! Keep 'cl--typeof-types' in sync with this code!! */ switch (PSEUDOVECTOR_TYPE (XVECTOR (object))) { case PVEC_NORMAL_VECTOR: return Qvector; @@ -1072,6 +1073,7 @@ Value, if non-nil, is a list (interactive SPEC). */) (Lisp_Object cmd) { Lisp_Object fun = indirect_function (cmd); /* Check cycles. */ + bool genfun = false; if (NILP (fun)) return Qnil; @@ -1090,10 +1092,10 @@ Value, if non-nil, is a list (interactive SPEC). */) if (SUBRP (fun)) { - if (SUBR_NATIVE_COMPILEDP (fun) && !NILP (XSUBR (fun)->native_intspec)) - return XSUBR (fun)->native_intspec; + if (SUBR_NATIVE_COMPILEDP (fun) && !NILP (XSUBR (fun)->intspec.native)) + return XSUBR (fun)->intspec.native; - const char *spec = XSUBR (fun)->intspec; + const char *spec = XSUBR (fun)->intspec.string; if (spec) return list2 (Qinteractive, (*spec != '(') ? build_string (spec) : @@ -1104,15 +1106,17 @@ Value, if non-nil, is a list (interactive SPEC). */) if (PVSIZE (fun) > COMPILED_INTERACTIVE) { Lisp_Object form = AREF (fun, COMPILED_INTERACTIVE); - if (VECTORP (form)) - /* The vector form is the new form, where the first - element is the interactive spec, and the second is the - command modes. */ - return list2 (Qinteractive, AREF (form, 0)); - else - /* Old form -- just the interactive spec. */ - return list2 (Qinteractive, form); + /* The vector form is the new form, where the first + element is the interactive spec, and the second is the + command modes. */ + return list2 (Qinteractive, VECTORP (form) ? AREF (form, 0) : form); } + else if (PVSIZE (fun) > COMPILED_DOC_STRING) + { + Lisp_Object doc = AREF (fun, COMPILED_DOC_STRING); + /* An invalid "docstring" is a sign that we have an OClosure. */ + genfun = !(NILP (doc) || VALID_DOCSTRING_P (doc)); + } } #ifdef HAVE_MODULES else if (MODULE_FUNCTIONP (fun)) @@ -1135,13 +1139,21 @@ Value, if non-nil, is a list (interactive SPEC). */) if (EQ (funcar, Qclosure)) form = Fcdr (form); Lisp_Object spec = Fassq (Qinteractive, form); - if (NILP (Fcdr (Fcdr (spec)))) + if (NILP (spec) && VALID_DOCSTRING_P (CAR_SAFE (form))) + /* A "docstring" is a sign that we may have an OClosure. */ + genfun = true; + else if (NILP (Fcdr (Fcdr (spec)))) return spec; else return list2 (Qinteractive, Fcar (Fcdr (spec))); } } - return Qnil; + if (genfun + /* Avoid burping during bootstrap. */ + && !NILP (Fsymbol_function (Qoclosure_interactive_form))) + return call1 (Qoclosure_interactive_form, fun); + else + return Qnil; } DEFUN ("command-modes", Fcommand_modes, Scommand_modes, 1, 1, 0, @@ -4123,6 +4135,7 @@ syms_of_data (void) DEFSYM (Qchar_table_p, "char-table-p"); DEFSYM (Qvector_or_char_table_p, "vector-or-char-table-p"); DEFSYM (Qfixnum_or_symbol_with_pos_p, "fixnum-or-symbol-with-pos-p"); + DEFSYM (Qoclosure_interactive_form, "oclosure-interactive-form"); DEFSYM (Qsubrp, "subrp"); DEFSYM (Qunevalled, "unevalled"); diff --git a/src/dispnew.c b/src/dispnew.c index 0d959047f3a..1dd64be4ead 100644 --- a/src/dispnew.c +++ b/src/dispnew.c @@ -3928,9 +3928,13 @@ update_text_area (struct window *w, struct glyph_row *updated_row, int vpos) However, it causes excessive flickering when mouse is moved across the mode line. Luckily, turning it off for the mode line doesn't seem to hurt anything. -- cyd. - But it is still needed for the header line. -- kfs. */ + But it is still needed for the header line. -- kfs. + The header line vpos is 1 if a tab line is enabled. (18th + Apr 2022) */ || (current_row->mouse_face_p - && !(current_row->mode_line_p && vpos > 0)) + && !(current_row->mode_line_p + && (vpos > (w->current_matrix->tab_line_p + && w->current_matrix->header_line_p)))) || current_row->x != desired_row->x) { output_cursor_to (w, vpos, 0, desired_row->y, desired_row->x); @@ -6717,6 +6721,10 @@ See `buffer-display-table' for more information. */); beginning of the next redisplay). */ redisplay_dont_pause = true; + DEFVAR_LISP ("x-show-tooltip-timeout", Vx_show_tooltip_timeout, + doc: /* The default timeout (in seconds) for `x-show-tip'. */); + Vx_show_tooltip_timeout = make_fixnum (5); + DEFVAR_LISP ("tab-bar-position", Vtab_bar_position, doc: /* Specify on which side from the tool bar the tab bar shall be. Possible values are t (below the tool bar), nil (above the tool bar). diff --git a/src/doc.c b/src/doc.c index 5326195c6a0..71e66853b08 100644 --- a/src/doc.c +++ b/src/doc.c @@ -469,9 +469,7 @@ store_function_docstring (Lisp_Object obj, EMACS_INT offset) if (PVSIZE (fun) > COMPILED_DOC_STRING /* Don't overwrite a non-docstring value placed there, * such as the symbols used for Oclosures. */ - && (FIXNUMP (AREF (fun, COMPILED_DOC_STRING)) - || STRINGP (AREF (fun, COMPILED_DOC_STRING)) - || CONSP (AREF (fun, COMPILED_DOC_STRING)))) + && VALID_DOCSTRING_P (AREF (fun, COMPILED_DOC_STRING))) ASET (fun, COMPILED_DOC_STRING, make_fixnum (offset)); else { diff --git a/src/emacs-module.c b/src/emacs-module.c index 0974a199e5e..0d3cce0276b 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -955,11 +955,9 @@ single memcpy to convert the magnitude. This way we largely avoid the import/export overhead on most platforms. */ -enum -{ - /* Documented maximum count of magnitude elements. */ - module_bignum_count_max = min (SIZE_MAX, PTRDIFF_MAX) / sizeof (emacs_limb_t) -}; +/* Documented maximum count of magnitude elements. */ +#define module_bignum_count_max \ + ((ptrdiff_t) min (SIZE_MAX, PTRDIFF_MAX) / sizeof (emacs_limb_t)) /* Verify that emacs_limb_t indeed has unique object representations. */ diff --git a/src/emacs.c b/src/emacs.c index a35996c07aa..ca99a8c787d 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -159,6 +159,10 @@ Lisp_Object empty_unibyte_string, empty_multibyte_string; #ifdef WINDOWSNT /* Cache for externally loaded libraries. */ Lisp_Object Vlibrary_cache; +/* Original command line string as received from the OS. */ +static char *initial_cmdline; +/* Original working directory when invoked. */ +static const char *initial_wd; #endif struct gflags gflags; @@ -229,6 +233,7 @@ HANDLE w32_daemon_event; /* Save argv and argc. */ char **initial_argv; int initial_argc; +static char *initial_emacs_executable = NULL; /* The name of the working directory, or NULL if this info is unavailable. */ char const *emacs_wd; @@ -291,7 +296,10 @@ Initialization options:\n\ -q --no-site-file --no-site-lisp --no-splash\n\ --no-x-resources\n\ --script FILE run FILE as an Emacs Lisp script\n\ ---terminal, -t DEVICE use DEVICE for terminal I/O\n\ +-x to be used in #!/usr/bin/emacs -x\n\ + and has approximately the same meaning\n\ + as -Q --script\n\ +--terminal, -t DEVICE use DEVICE for terminal I/O\n \ --user, -u USER load ~USER/.emacs instead of your own\n\ \n\ ", @@ -427,7 +435,7 @@ terminate_due_to_signal (int sig, int backtrace_limit) don't care about the message stack. */ if (sig == SIGINT && noninteractive) clear_message_stack (); - Fkill_emacs (make_fixnum (sig)); + Fkill_emacs (make_fixnum (sig), Qnil); } shut_down_emacs (sig, Qnil); @@ -710,34 +718,6 @@ argmatch (char **argv, int argc, const char *sstr, const char *lstr, } } -#ifdef HAVE_PDUMPER - -static const char * -dump_error_to_string (int result) -{ - switch (result) - { - case PDUMPER_LOAD_SUCCESS: - return "success"; - case PDUMPER_LOAD_OOM: - return "out of memory"; - case PDUMPER_NOT_LOADED: - return "not loaded"; - case PDUMPER_LOAD_FILE_NOT_FOUND: - return "could not open file"; - case PDUMPER_LOAD_BAD_FILE_TYPE: - return "not a dump file"; - case PDUMPER_LOAD_FAILED_DUMP: - return "dump file is result of failed dump attempt"; - case PDUMPER_LOAD_VERSION_MISMATCH: - return "not built for this Emacs executable"; - default: - return (result <= PDUMPER_LOAD_ERROR - ? "generic error" - : strerror (result - PDUMPER_LOAD_ERROR)); - } -} - /* Find a name (absolute or relative) of the Emacs executable whose name (as passed into this program) is ARGV0. Called early in initialization by portable dumper loading code, so avoid Lisp and @@ -746,7 +726,7 @@ dump_error_to_string (int result) if not found. Store into *CANDIDATE_SIZE a lower bound on the size of any heap allocation. */ static char * -load_pdump_find_executable (char const *argv0, ptrdiff_t *candidate_size) +find_emacs_executable (char const *argv0, ptrdiff_t *candidate_size) { *candidate_size = 0; @@ -837,7 +817,36 @@ load_pdump_find_executable (char const *argv0, ptrdiff_t *candidate_size) #endif /* !WINDOWSNT */ } -static void +#ifdef HAVE_PDUMPER + +static const char * +dump_error_to_string (int result) +{ + switch (result) + { + case PDUMPER_LOAD_SUCCESS: + return "success"; + case PDUMPER_LOAD_OOM: + return "out of memory"; + case PDUMPER_NOT_LOADED: + return "not loaded"; + case PDUMPER_LOAD_FILE_NOT_FOUND: + return "could not open file"; + case PDUMPER_LOAD_BAD_FILE_TYPE: + return "not a dump file"; + case PDUMPER_LOAD_FAILED_DUMP: + return "dump file is result of failed dump attempt"; + case PDUMPER_LOAD_VERSION_MISMATCH: + return "not built for this Emacs executable"; + default: + return (result <= PDUMPER_LOAD_ERROR + ? "generic error" + : strerror (result - PDUMPER_LOAD_ERROR)); + } +} + +/* This function returns the Emacs executable. */ +static char * load_pdump (int argc, char **argv) { const char *const suffix = ".pdmp"; @@ -886,7 +895,7 @@ load_pdump (int argc, char **argv) #ifndef NS_SELF_CONTAINED ptrdiff_t exec_bufsize; #endif - emacs_executable = load_pdump_find_executable (argv[0], &bufsize); + emacs_executable = find_emacs_executable (argv[0], &bufsize); #ifndef NS_SELF_CONTAINED exec_bufsize = bufsize; #endif @@ -903,7 +912,7 @@ load_pdump (int argc, char **argv) if (result != PDUMPER_LOAD_SUCCESS) fatal ("could not load dump file \"%s\": %s", dump_file, dump_error_to_string (result)); - return; + return emacs_executable; } /* Look for a dump file in the same directory as the executable; it @@ -1028,7 +1037,8 @@ load_pdump (int argc, char **argv) out: xfree (dump_file); - xfree (emacs_executable); + + return emacs_executable; } #endif /* HAVE_PDUMPER */ @@ -1319,6 +1329,7 @@ main (int argc, char **argv) } } init_heap (use_dynamic_heap); + initial_cmdline = GetCommandLine (); #endif #if defined WINDOWSNT || defined HAVE_NTGUI /* Set global variables used to detect Windows version. Do this as @@ -1341,7 +1352,10 @@ main (int argc, char **argv) #ifdef HAVE_PDUMPER if (attempt_load_pdump) - load_pdump (argc, argv); + initial_emacs_executable = load_pdump (argc, argv); +#else + ptrdiff_t bufsize; + initial_emacs_executable = find_emacs_executable (argv[0], &bufsize); #endif argc = maybe_disable_address_randomization (argc, argv); @@ -1465,6 +1479,9 @@ main (int argc, char **argv) #endif emacs_wd = emacs_get_current_dir_name (); +#ifdef WINDOWSNT + initial_wd = emacs_wd; +#endif #ifdef HAVE_PDUMPER if (dumped_with_pdumper_p ()) pdumper_record_wd (emacs_wd); @@ -2049,6 +2066,16 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem no_site_lisp = 1; } + if (argmatch (argv, argc, "-x", 0, 1, &junk, &skip_args)) + { + noninteractive = 1; + no_site_lisp = 1; + /* This is picked up in startup.el. */ + argv[skip_args - 1] = (char *) "-scripteval"; + skip_args -= 1; + sort_args (argc, argv); + } + /* Don't actually discard this arg. */ skip_args = count_before; } @@ -2490,6 +2517,7 @@ static const struct standard_args standard_args[] = /* (Note that to imply -nsl, -Q is partially handled here.) */ { "-Q", "--quick", 55, 0 }, { "-quick", 0, 55, 0 }, + { "-x", 0, 55, 0 }, { "-q", "--no-init-file", 50, 0 }, { "-no-init-file", 0, 50, 0 }, { "-init-directory", "--init-directory", 30, 1 }, @@ -2740,24 +2768,47 @@ sort_args (int argc, char **argv) xfree (priority); } -DEFUN ("kill-emacs", Fkill_emacs, Skill_emacs, 0, 1, "P", +DEFUN ("kill-emacs", Fkill_emacs, Skill_emacs, 0, 2, "P", doc: /* Exit the Emacs job and kill it. If ARG is an integer, return ARG as the exit program code. If ARG is a string, stuff it as keyboard input. Any other value of ARG, or ARG omitted, means return an exit code that indicates successful program termination. +If RESTART is non-nil, instead of just exiting at the end, start a new +Emacs process, using the same command line arguments as the currently +running Emacs process. + This function is called upon receipt of the signals SIGTERM or SIGHUP, and upon SIGINT in batch mode. -The value of `kill-emacs-hook', if not void, -is a list of functions (of no args), -all of which are called before Emacs is actually killed. */ +The value of `kill-emacs-hook', if not void, is a list of functions +(of no args), all of which are called before Emacs is actually +killed. */ attributes: noreturn) - (Lisp_Object arg) + (Lisp_Object arg, Lisp_Object restart) { int exit_code; +#ifndef WINDOWSNT + /* Do some checking before shutting down Emacs, because errors + can't be meaningfully reported afterwards. */ + if (!NILP (restart)) + { + /* This is very unlikely, but it's possible to execute a binary + (on some systems) with no argv. */ + if (initial_argc < 1) + error ("No command line arguments known; unable to re-execute Emacs"); + + /* Check that the binary hasn't gone away. */ + if (!initial_emacs_executable) + error ("Unknown Emacs executable"); + + if (!file_access_p (initial_emacs_executable, F_OK)) + error ("Emacs executable \"%s\" can't be found", initial_argv[0]); + } +#endif + #ifdef HAVE_LIBSYSTEMD /* Notify systemd we are shutting down, but only if we have notified it about startup. */ @@ -2801,6 +2852,17 @@ all of which are called before Emacs is actually killed. */ eln_load_path_final_clean_up (); #endif + if (!NILP (restart)) + { +#ifdef WINDOWSNT + if (w32_reexec_emacs (initial_cmdline, initial_wd) < 0) +#else + initial_argv[0] = initial_emacs_executable; + if (execvp (*initial_argv, initial_argv) < 1) +#endif + emacs_perror ("Unable to re-execute Emacs"); + } + if (FIXNUMP (arg)) exit_code = (XFIXNUM (arg) < 0 ? XFIXNUM (arg) | INT_MIN @@ -3091,6 +3153,9 @@ decode_env_path (const char *evarname, const char *defalt, bool empty) { const char *path, *p; Lisp_Object lpath, element, tem; +#ifdef NS_SELF_CONTAINED + void *autorelease = NULL; +#endif /* Default is to use "." for empty path elements. But if argument EMPTY is true, use nil instead. */ Lisp_Object empty_element = empty ? Qnil : build_string ("."); @@ -3118,6 +3183,8 @@ decode_env_path (const char *evarname, const char *defalt, bool empty) if (!path) { #ifdef NS_SELF_CONTAINED + /* ns_relocate needs a valid autorelease pool around it. */ + autorelease = ns_alloc_autorelease_pool (); path = ns_relocate (defalt); #else path = defalt; @@ -3220,6 +3287,11 @@ decode_env_path (const char *evarname, const char *defalt, bool empty) else break; } + +#ifdef NS_SELF_CONTAINED + if (autorelease) + ns_release_autorelease_pool (autorelease); +#endif return Fnreverse (lpath); } diff --git a/src/eval.c b/src/eval.c index a1cebcd0257..77ec47e2b79 100644 --- a/src/eval.c +++ b/src/eval.c @@ -1613,7 +1613,7 @@ process_quit_flag (void) Lisp_Object flag = Vquit_flag; Vquit_flag = Qnil; if (EQ (flag, Qkill_emacs)) - Fkill_emacs (Qnil); + Fkill_emacs (Qnil, Qnil); if (EQ (Vthrow_on_input, flag)) Fthrow (Vthrow_on_input, Qt); quit (); @@ -2032,8 +2032,7 @@ then strings and vectors are not accepted. */) (Lisp_Object function, Lisp_Object for_call_interactively) { register Lisp_Object fun; - register Lisp_Object funcar; - Lisp_Object if_prop = Qnil; + bool genfun = false; /* If true, we should consult `interactive-form'. */ fun = function; @@ -2041,52 +2040,89 @@ then strings and vectors are not accepted. */) if (NILP (fun)) return Qnil; - /* Check an `interactive-form' property if present, analogous to the - function-documentation property. */ - fun = function; - while (SYMBOLP (fun)) - { - Lisp_Object tmp = Fget (fun, Qinteractive_form); - if (!NILP (tmp)) - if_prop = Qt; - fun = Fsymbol_function (fun); - } - /* Emacs primitives are interactive if their DEFUN specifies an interactive spec. */ if (SUBRP (fun)) - return XSUBR (fun)->intspec ? Qt : if_prop; - + { + if (XSUBR (fun)->intspec.string) + return Qt; + } /* Bytecode objects are interactive if they are long enough to have an element whose index is COMPILED_INTERACTIVE, which is where the interactive spec is stored. */ else if (COMPILEDP (fun)) - return (PVSIZE (fun) > COMPILED_INTERACTIVE ? Qt : if_prop); + { + if (PVSIZE (fun) > COMPILED_INTERACTIVE) + return Qt; + else if (PVSIZE (fun) > COMPILED_DOC_STRING) + { + Lisp_Object doc = AREF (fun, COMPILED_DOC_STRING); + /* An invalid "docstring" is a sign that we have an OClosure. */ + genfun = !(NILP (doc) || VALID_DOCSTRING_P (doc)); + } + } #ifdef HAVE_MODULES /* Module functions are interactive if their `interactive_form' field is non-nil. */ else if (MODULE_FUNCTIONP (fun)) - return NILP (module_function_interactive_form (XMODULE_FUNCTION (fun))) - ? if_prop - : Qt; + { + if (!NILP (module_function_interactive_form (XMODULE_FUNCTION (fun)))) + return Qt; + } #endif /* Strings and vectors are keyboard macros. */ - if (STRINGP (fun) || VECTORP (fun)) + else if (STRINGP (fun) || VECTORP (fun)) return (NILP (for_call_interactively) ? Qt : Qnil); /* Lists may represent commands. */ - if (!CONSP (fun)) + else if (!CONSP (fun)) return Qnil; - funcar = XCAR (fun); - if (EQ (funcar, Qclosure)) - return (!NILP (Fassq (Qinteractive, Fcdr (Fcdr (XCDR (fun))))) - ? Qt : if_prop); - else if (EQ (funcar, Qlambda)) - return !NILP (Fassq (Qinteractive, Fcdr (XCDR (fun)))) ? Qt : if_prop; - else if (EQ (funcar, Qautoload)) - return !NILP (Fcar (Fcdr (Fcdr (XCDR (fun))))) ? Qt : if_prop; + else + { + Lisp_Object funcar = XCAR (fun); + if (EQ (funcar, Qautoload)) + { + if (!NILP (Fcar (Fcdr (Fcdr (XCDR (fun)))))) + return Qt; + } + else + { + Lisp_Object body = CDR_SAFE (XCDR (fun)); + if (EQ (funcar, Qclosure)) + body = CDR_SAFE (body); + else if (!EQ (funcar, Qlambda)) + return Qnil; + if (!NILP (Fassq (Qinteractive, body))) + return Qt; + else if (VALID_DOCSTRING_P (CAR_SAFE (body))) + /* A "docstring" is a sign that we may have an OClosure. */ + genfun = true; + } + } + + /* By now, if it's not a function we already returned nil. */ + + /* Check an `interactive-form' property if present, analogous to the + function-documentation property. */ + fun = function; + while (SYMBOLP (fun)) + { + Lisp_Object tmp = Fget (fun, Qinteractive_form); + if (!NILP (tmp)) + error ("Found an 'interactive-form' property!"); + fun = Fsymbol_function (fun); + } + + /* If there's no immediate interactive form but it's an OClosure, + then delegate to the generic-function in case it has + a type-specific interactive-form. */ + if (genfun) + { + Lisp_Object iform = call1 (Qinteractive_form, fun); + return NILP (iform) ? Qnil : Qt; + } else return Qnil; } diff --git a/src/filelock.c b/src/filelock.c index 4fdad8d8560..a657cc4582c 100644 --- a/src/filelock.c +++ b/src/filelock.c @@ -413,14 +413,20 @@ create_lock_file (char *lfname, char *lock_info_str, bool force) Return 0 if successful, an error number on failure. */ static int -lock_file_1 (char *lfname, bool force) +lock_file_1 (Lisp_Object lfname, bool force) { - /* Call this first because it can GC. */ intmax_t boot = get_boot_time (); - Lisp_Object luser_name = Fuser_login_name (Qnil); - char const *user_name = STRINGP (luser_name) ? SSDATA (luser_name) : ""; Lisp_Object lhost_name = Fsystem_name (); + + /* Protect against the extremely unlikely case of the host name + containing an @ character. */ + if (!NILP (lhost_name) && strchr (SSDATA (lhost_name), '@')) + lhost_name = CALLN (Ffuncall, intern ("string-replace"), + build_string ("@"), build_string ("-"), + lhost_name); + + char const *user_name = STRINGP (luser_name) ? SSDATA (luser_name) : ""; char const *host_name = STRINGP (lhost_name) ? SSDATA (lhost_name) : ""; char lock_info_str[MAX_LFINFO + 1]; intmax_t pid = getpid (); @@ -439,7 +445,7 @@ lock_file_1 (char *lfname, bool force) user_name, host_name, pid)) return ENAMETOOLONG; - return create_lock_file (lfname, lock_info_str, force); + return create_lock_file (SSDATA (lfname), lock_info_str, force); } /* Return true if times A and B are no more than one second apart. */ @@ -511,7 +517,7 @@ enum or an errno value if something is wrong with the locking mechanism. */ static int -current_lock_owner (lock_info_type *owner, char *lfname) +current_lock_owner (lock_info_type *owner, Lisp_Object lfname) { lock_info_type local_owner; ptrdiff_t lfinfolen; @@ -524,7 +530,7 @@ current_lock_owner (lock_info_type *owner, char *lfname) owner = &local_owner; /* If nonexistent lock file, all is well; otherwise, got strange error. */ - lfinfolen = read_lock_data (lfname, owner->user); + lfinfolen = read_lock_data (SSDATA (lfname), owner->user); if (lfinfolen < 0) return errno == ENOENT || errno == ENOTDIR ? 0 : errno; if (MAX_LFINFO < lfinfolen) @@ -584,6 +590,12 @@ current_lock_owner (lock_info_type *owner, char *lfname) .#test.txt -> larsi@.118961:1646577954) is an empty string. */ if (NILP (system_name)) system_name = build_string (""); + /* Protect against the extremely unlikely case of the host name + containing an @ character. */ + else if (strchr (SSDATA (system_name), '@')) + system_name = CALLN (Ffuncall, intern ("string-replace"), + build_string ("@"), build_string ("-"), + system_name); /* On current host? */ if (STRINGP (system_name) && dot - (at + 1) == SBYTES (system_name) @@ -600,7 +612,7 @@ current_lock_owner (lock_info_type *owner, char *lfname) /* The owner process is dead or has a strange pid, so try to zap the lockfile. */ else - return unlink (lfname) < 0 ? errno : 0; + return unlink (SSDATA (lfname)) < 0 ? errno : 0; } else { /* If we wanted to support the check for stale locks on remote machines, @@ -617,7 +629,7 @@ current_lock_owner (lock_info_type *owner, char *lfname) Return errno value if cannot lock for any other reason. */ static int -lock_if_free (lock_info_type *clasher, char *lfname) +lock_if_free (lock_info_type *clasher, Lisp_Object lfname) { int err; while ((err = lock_file_1 (lfname, 0)) == EEXIST) @@ -636,10 +648,14 @@ lock_if_free (lock_info_type *clasher, char *lfname) return err; } +/* Return the encoded name of the lock file for FN, or nil if none. */ + static Lisp_Object make_lock_file_name (Lisp_Object fn) { - return call1 (Qmake_lock_file_name, Fexpand_file_name (fn, Qnil)); + Lisp_Object lock_file_name = call1 (Qmake_lock_file_name, + Fexpand_file_name (fn, Qnil)); + return !NILP (lock_file_name) ? ENCODE_FILE (lock_file_name) : Qnil; } /* lock_file locks file FN, @@ -663,7 +679,6 @@ 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. @@ -672,13 +687,13 @@ lock_file (Lisp_Object fn) if (will_dump_p ()) return Qnil; + Lisp_Object lfname = Qnil; if (create_lockfiles) { /* Create the name of the lock-file for file fn */ - Lisp_Object lock_filename = make_lock_file_name (fn); - if (NILP (lock_filename)) + lfname = make_lock_file_name (fn); + if (NILP (lfname)) return Qnil; - lfname = SSDATA (ENCODE_FILE (lock_filename)); } /* See if this file is visited and has changed on disk since it was @@ -687,14 +702,14 @@ lock_file (Lisp_Object fn) if (!NILP (subject_buf) && NILP (Fverify_visited_file_modtime (subject_buf)) && !NILP (Ffile_exists_p (fn)) - && !(lfname && (current_lock_owner (NULL, lfname) == I_OWN_IT))) + && !(!NILP (lfname) && current_lock_owner (NULL, lfname) == I_OWN_IT)) call1 (intern ("userlock--ask-user-about-supersession-threat"), fn); /* Don't do locking if the user has opted out. */ - if (lfname) + if (!NILP (lfname)) { /* Try to lock the lock. FIXME: This ignores errors when - lock_if_free returns a positive errno value. */ + lock_if_free returns an errno value. */ if (lock_if_free (&lock_info, lfname) == ANOTHER_OWNS_IT) { /* Someone else has the lock. Consider breaking it. */ @@ -719,17 +734,14 @@ lock_file (Lisp_Object fn) static Lisp_Object unlock_file (Lisp_Object fn) { - char *lfname; - - Lisp_Object lock_filename = make_lock_file_name (fn); - if (NILP (lock_filename)) + Lisp_Object lfname = make_lock_file_name (fn); + if (NILP (lfname)) return Qnil; - lfname = SSDATA (ENCODE_FILE (lock_filename)); int err = current_lock_owner (0, lfname); if (! (err == 0 || err == ANOTHER_OWNS_IT || (err == I_OWN_IT - && (unlink (lfname) == 0 || (err = errno) == ENOENT)))) + && (unlink (SSDATA (lfname)) == 0 || (err = errno) == ENOENT)))) report_file_errno ("Unlocking file", fn, err); return Qnil; @@ -871,10 +883,9 @@ t if it is locked by you, else a string saying which user has locked it. */) return call2 (handler, Qfile_locked_p, filename); } - Lisp_Object lock_filename = make_lock_file_name (filename); - if (NILP (lock_filename)) + Lisp_Object lfname = make_lock_file_name (filename); + if (NILP (lfname)) return Qnil; - char *lfname = SSDATA (ENCODE_FILE (lock_filename)); owner = current_lock_owner (&locker, lfname); switch (owner) @@ -900,8 +911,8 @@ syms_of_filelock (void) DEFVAR_BOOL ("create-lockfiles", create_lockfiles, doc: /* Non-nil means use lockfiles to avoid editing collisions. -The name of the (per-buffer) lockfile is constructed by prepending a -'.#' to the name of the file being locked. See also `lock-buffer' and +The name of the (per-buffer) lockfile is constructed by prepending +".#" to the name of the file being locked. See also `lock-buffer' and Info node `(emacs)Interlocking'. */); create_lockfiles = true; diff --git a/src/font.c b/src/font.c index 7e0219181c9..6297452d3e0 100644 --- a/src/font.c +++ b/src/font.c @@ -4237,26 +4237,33 @@ merge_font_spec (Lisp_Object from, Lisp_Object to) DEFUN ("font-get", Ffont_get, Sfont_get, 2, 2, 0, doc: /* Return the value of FONT's property KEY. FONT is a font-spec, a font-entity, or a font-object. -KEY is any symbol, but these are reserved for specific meanings: - :family, :weight, :slant, :width, :foundry, :adstyle, :registry, - :size, :name, :script, :otf +KEY can be any symbol, but these are reserved for specific meanings: + :foundry, :family, :adstyle, :registry, :weight, :slant, :width, + :size, :dpi, :spacing, :avgwidth, :script, :lang, :otf See the documentation of `font-spec' for their meanings. -In addition, if FONT is a font-entity or a font-object, values of -:script and :otf are different from those of a font-spec as below: -The value of :script may be a list of scripts that are supported by the font. +If FONT is a font-entity or a font-object, then values of +:script and :otf properties are different from those of a font-spec +as below: -The value of :otf is a cons (GSUB . GPOS) where GSUB and GPOS are lists -representing the OpenType features supported by the font by this form: - ((SCRIPT (LANGSYS FEATURE ...) ...) ...) -SCRIPT, LANGSYS, and FEATURE are all symbols representing OpenType -Layout tags. + The value of :script may be a list of scripts that are supported by + the font. + + The value of :otf is a cons (GSUB . GPOS) where GSUB and GPOS are + lists representing the OpenType features supported by the font, of + this form: ((SCRIPT (LANGSYS FEATURE ...) ...) ...), where + SCRIPT, LANGSYS, and FEATURE are all symbols representing OpenType + Layout tags. See `otf-script-alist' for the OpenType script tags. In addition to the keys listed above, the following keys are reserved for the specific meanings as below: -The value of :combining-capability is non-nil if the font-backend of -FONT supports rendering of combining characters for non-OTF fonts. */) + The value of :type is a symbol that identifies the font backend to be + used, such as `ftcrhb' or `xfthb' on X , `harfbuzz' or `uniscribe' on + MS-Windows, `ns' on Cocoa/GNUstep, etc. + + The value of :combining-capability is non-nil if the font-backend of + FONT supports rendering of combining characters for non-OTF fonts. */) (Lisp_Object font, Lisp_Object key) { int idx; @@ -4384,7 +4391,9 @@ accepted by the function `font-spec' (which see), VAL must be what allowed in `font-spec'. If FONT is a font-entity or a font-object, KEY must not be the one -accepted by `font-spec'. */) +accepted by `font-spec'. + +See also `font-get' for KEYs that have special meanings. */) (Lisp_Object font, Lisp_Object prop, Lisp_Object val) { int idx; diff --git a/src/font.h b/src/font.h index 424616a4a1e..06bd297ccb2 100644 --- a/src/font.h +++ b/src/font.h @@ -155,8 +155,9 @@ enum font_property_index /* In a font-spec, the value is an alist of extra information of a font such as name, OpenType features, and language coverage. In addition, in a font-entity, the value may contain a pair - (font-entity . INFO) where INFO is extra information to identify - a font (font-driver dependent). */ + (font-entity . INFO) where INFO is extra information to + identify a font (font-driver dependent). In a font-entity, + this holds font driver-specific information. */ FONT_EXTRA_INDEX, /* alist alist */ /* This value is the length of font-spec vector. */ diff --git a/src/fontset.c b/src/fontset.c index eb563a69e2b..1793715450e 100644 --- a/src/fontset.c +++ b/src/fontset.c @@ -1450,28 +1450,30 @@ static void update_auto_fontset_alist (Lisp_Object, Lisp_Object); DEFUN ("set-fontset-font", Fset_fontset_font, Sset_fontset_font, 3, 5, 0, doc: /* -Modify fontset NAME to use FONT-SPEC for TARGET characters. +Modify FONTSET to use font specification in FONT-SPEC for displaying CHARACTERS. -NAME is a fontset name (a string), nil for the fontset of FRAME, -or t for the default fontset. +FONTSET should be a fontset name (a string); or nil, meaning the +fontset of FRAME; or t, meaning the default fontset. -TARGET may be a single character to use FONT-SPEC for. +CHARACTERS may be a single character to use FONT-SPEC for. -TARGET may be a cons (FROM . TO), where FROM and TO are characters. +CHARACTERS may be a cons (FROM . TO), where FROM and TO are characters. In that case, use FONT-SPEC for all the characters in the range between FROM and TO (inclusive). -TARGET may be a script symbol. In that case, use FONT-SPEC for +CHARACTERS may be a script symbol. In that case, use FONT-SPEC for all the characters that belong to the script. See the variable -`script-representative-chars' for the list of known scripts. +`script-representative-chars' for the list of known scripts, and +see the variable `char-script-table' for the script of any specific +character. -TARGET may be a charset. In that case, use FONT-SPEC for all -the characters in the charset. See `list-character-sets' and +CHARACTERS may be a charset symbol. In that case, use FONT-SPEC for +all the characters in the charset. See `list-character-sets' and `list-charset-chars' for the list of character sets and their characters. -TARGET may be nil. In that case, use FONT-SPEC for any character for -which no font-spec is specified. +CHARACTERS may be nil. In that case, use FONT-SPEC for any +character for which no font-spec is specified in FONTSET. FONT-SPEC may one of these: * A font-spec object made by the function `font-spec' (which see). @@ -1479,25 +1481,28 @@ FONT-SPEC may one of these: REGISTRY is a font registry name. FAMILY may contain foundry name, and REGISTRY may contain encoding name. * A font name string. - * nil, which explicitly specifies that there's no font for TARGET. + * nil, which explicitly specifies that there's no font for CHARACTERS. -Optional 4th argument FRAME is a frame, or nil for the selected frame, -to be considered in the case that NAME is nil. +Optional 4th argument FRAME is a frame whose fontset should be modified; +it is used if FONTSET is nil. If FONTSET is nil and FRAME is omitted +or nil, that stands for the fontset of the selected frame. Optional 5th argument ADD, if non-nil, specifies how to add FONT-SPEC -to the previously set font specifications for TARGET. If it is -`prepend', FONT-SPEC is prepended. If it is `append', FONT-SPEC is -appended. By default, FONT-SPEC overrides the previous settings. */) - (Lisp_Object name, Lisp_Object target, Lisp_Object font_spec, Lisp_Object frame, Lisp_Object add) +to the previously set font specifications for CHARACTERS. If it is +`prepend', FONT-SPEC is prepended to the existing font specifications. +If it is `append', FONT-SPEC is appended. By default, FONT-SPEC +overwrites the previous settings. */) + (Lisp_Object fontset, Lisp_Object characters, Lisp_Object font_spec, + Lisp_Object frame, Lisp_Object add) { - Lisp_Object fontset; + Lisp_Object fontset_obj; Lisp_Object font_def, registry, family; Lisp_Object range_list; struct charset *charset = NULL; Lisp_Object fontname; bool ascii_changed = 0; - fontset = check_fontset_name (name, &frame); + fontset_obj = check_fontset_name (fontset, &frame); fontname = Qnil; if (CONSP (font_spec)) @@ -1555,18 +1560,18 @@ appended. By default, FONT-SPEC overrides the previous settings. */) else font_def = Qnil; - if (CHARACTERP (target)) + if (CHARACTERP (characters)) { - if (XFIXNAT (target) < 0x80) + if (XFIXNAT (characters) < 0x80) error ("Can't set a font for partial ASCII range"); - range_list = list1 (Fcons (target, target)); + range_list = list1 (Fcons (characters, characters)); } - else if (CONSP (target)) + else if (CONSP (characters)) { Lisp_Object from, to; - from = Fcar (target); - to = Fcdr (target); + from = Fcar (characters); + to = Fcdr (characters); CHECK_CHARACTER (from); CHECK_CHARACTER (to); if (XFIXNAT (from) < 0x80) @@ -1575,38 +1580,38 @@ appended. By default, FONT-SPEC overrides the previous settings. */) error ("Can't set a font for partial ASCII range"); ascii_changed = 1; } - range_list = list1 (target); + range_list = list1 (characters); } - else if (SYMBOLP (target) && !NILP (target)) + else if (SYMBOLP (characters) && !NILP (characters)) { Lisp_Object script_list; Lisp_Object val; range_list = Qnil; script_list = XCHAR_TABLE (Vchar_script_table)->extras[0]; - if (! NILP (Fmemq (target, script_list))) + if (! NILP (Fmemq (characters, script_list))) { - if (EQ (target, Qlatin)) + if (EQ (characters, Qlatin)) ascii_changed = 1; - val = list1 (target); + val = list1 (characters); map_char_table (accumulate_script_ranges, Qnil, Vchar_script_table, val); range_list = Fnreverse (XCDR (val)); } - if (CHARSETP (target)) + if (CHARSETP (characters)) { - CHECK_CHARSET_GET_CHARSET (target, charset); + CHECK_CHARSET_GET_CHARSET (characters, charset); if (charset->ascii_compatible_p) ascii_changed = 1; } else if (NILP (range_list)) error ("Invalid script or charset name: %s", - SDATA (SYMBOL_NAME (target))); + SDATA (SYMBOL_NAME (characters))); } - else if (NILP (target)) + else if (NILP (characters)) range_list = list1 (Qnil); else - error ("Invalid target for setting a font"); + error ("Invalid second argument for setting a font in a fontset"); if (ascii_changed) { @@ -1614,7 +1619,7 @@ appended. By default, FONT-SPEC overrides the previous settings. */) if (NILP (font_spec)) error ("Can't set ASCII font to nil"); - val = CHAR_TABLE_REF (fontset, 0); + val = CHAR_TABLE_REF (fontset_obj, 0); if (! NILP (val) && EQ (add, Qappend)) /* We are going to change just an additional font for ASCII. */ ascii_changed = 0; @@ -1622,7 +1627,7 @@ appended. By default, FONT-SPEC overrides the previous settings. */) if (charset) { - Lisp_Object arg = CALLN (Fvector, fontset, font_def, add, + Lisp_Object arg = CALLN (Fvector, fontset_obj, font_def, add, ascii_changed ? Qt : Qnil, range_list); map_charset_chars (set_fontset_font, Qnil, arg, charset, @@ -1631,15 +1636,15 @@ appended. By default, FONT-SPEC overrides the previous settings. */) range_list = AREF (arg, 4); } for (; CONSP (range_list); range_list = XCDR (range_list)) - FONTSET_ADD (fontset, XCAR (range_list), font_def, add); + FONTSET_ADD (fontset_obj, XCAR (range_list), font_def, add); if (ascii_changed) { Lisp_Object tail, fr; - int fontset_id = XFIXNUM (FONTSET_ID (fontset)); + int fontset_id = XFIXNUM (FONTSET_ID (fontset_obj)); - set_fontset_ascii (fontset, fontname); - name = FONTSET_NAME (fontset); + set_fontset_ascii (fontset_obj, fontname); + fontset = FONTSET_NAME (fontset_obj); FOR_EACH_FRAME (tail, fr) { struct frame *f = XFRAME (fr); @@ -1657,17 +1662,17 @@ appended. By default, FONT-SPEC overrides the previous settings. */) font_object = font_open_by_spec (f, font_spec); if (! NILP (font_object)) { - update_auto_fontset_alist (font_object, fontset); - AUTO_FRAME_ARG (arg, Qfont, Fcons (name, font_object)); + update_auto_fontset_alist (font_object, fontset_obj); + AUTO_FRAME_ARG (arg, Qfont, Fcons (fontset, font_object)); Fmodify_frame_parameters (fr, arg); } } } - /* Free all realized fontsets whose base is FONTSET. This way, the + /* Free all realized fontsets whose base is FONTSET_OBJ. This way, the specified character(s) are surely redisplayed by a correct font. */ - free_realized_fontsets (fontset); + free_realized_fontsets (fontset_obj); return Qnil; } diff --git a/src/fringe.c b/src/fringe.c index bc4e0f1f136..bf0b5fde761 100644 --- a/src/fringe.c +++ b/src/fringe.c @@ -30,7 +30,9 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include "termhooks.h" #include "pdumper.h" -#include "pgtkterm.h" +#ifdef HAVE_PGTK +# include "pgtkterm.h" +#endif /* Fringe bitmaps are represented in three different ways: diff --git a/src/gtkutil.c b/src/gtkutil.c index 718da171f49..a2ab01d02c5 100644 --- a/src/gtkutil.c +++ b/src/gtkutil.c @@ -1061,6 +1061,7 @@ xg_set_geometry (struct frame *f) /* Handle negative positions without consulting gtk_window_parse_geometry (Bug#25851). The position will be off by scrollbar width + window manager decorations. */ +#ifndef HAVE_PGTK if (f->size_hint_flags & XNegative) f->left_pos = (x_display_pixel_width (FRAME_DISPLAY_INFO (f)) - FRAME_PIXEL_WIDTH (f) + f->left_pos); @@ -1068,6 +1069,15 @@ xg_set_geometry (struct frame *f) if (f->size_hint_flags & YNegative) f->top_pos = (x_display_pixel_height (FRAME_DISPLAY_INFO (f)) - FRAME_PIXEL_HEIGHT (f) + f->top_pos); +#else + if (f->size_hint_flags & XNegative) + f->left_pos = (pgtk_display_pixel_width (FRAME_DISPLAY_INFO (f)) + - FRAME_PIXEL_WIDTH (f) + f->left_pos); + + if (f->size_hint_flags & YNegative) + f->top_pos = (pgtk_display_pixel_height (FRAME_DISPLAY_INFO (f)) + - FRAME_PIXEL_HEIGHT (f) + f->top_pos); +#endif /* GTK works in scaled pixels, so convert from X pixels. */ gtk_window_move (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)), @@ -1182,7 +1192,7 @@ xg_frame_set_char_size (struct frame *f, int width, int height) outer_height /= xg_get_scale (f); outer_width /= xg_get_scale (f); - x_wm_set_size_hint (f, 0, 0); + xg_wm_set_size_hint (f, 0, 0); /* Resize the top level widget so rows and columns remain constant. @@ -1898,7 +1908,7 @@ xg_free_frame_widgets (struct frame *f) flag (this is useful when FLAGS is 0). */ void -x_wm_set_size_hint (struct frame *f, long int flags, bool user_position) +xg_wm_set_size_hint (struct frame *f, long int flags, bool user_position) { /* Must use GTK routines here, otherwise GTK resets the size hints to its own defaults. */ diff --git a/src/gtkutil.h b/src/gtkutil.h index 63ecac07907..190d6628314 100644 --- a/src/gtkutil.h +++ b/src/gtkutil.h @@ -153,6 +153,8 @@ extern bool xg_event_is_for_scrollbar (struct frame *, const EVENT *, extern int xg_get_default_scrollbar_width (struct frame *f); extern int xg_get_default_scrollbar_height (struct frame *f); +extern void xg_wm_set_size_hint (struct frame *, long int, bool); + extern void update_frame_tool_bar (struct frame *f); extern void free_frame_tool_bar (struct frame *f); extern void xg_change_toolbar_position (struct frame *f, Lisp_Object pos); @@ -222,7 +224,7 @@ extern bool xg_is_menu_window (Display *dpy, Window); extern bool xg_filter_key (struct frame *frame, XEvent *xkey); #endif -/* Mark all callback data that are Lisp_object:s during GC. */ +/* Mark all callback data that are Lisp_Objects during GC. */ extern void xg_mark_data (void); /* Initialize GTK specific parts. */ diff --git a/src/haiku_draw_support.cc b/src/haiku_draw_support.cc index f8df298958f..a8d46d000a3 100644 --- a/src/haiku_draw_support.cc +++ b/src/haiku_draw_support.cc @@ -469,16 +469,6 @@ BView_FillTriangle (void *view, int x1, int y1, } void -BView_SetHighColorForVisibleBell (void *view, uint32_t color) -{ - BView *vw = (BView *) view; - rgb_color col; - rgb32_to_rgb_color (color, &col); - - vw->SetHighColor (col); -} - -void BView_InvertRect (void *view, int x, int y, int width, int height) { BView *vw = get_view (view); diff --git a/src/haiku_font_support.cc b/src/haiku_font_support.cc index fd41ee71f04..ca6aaf71204 100644 --- a/src/haiku_font_support.cc +++ b/src/haiku_font_support.cc @@ -27,15 +27,111 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include "haiku_support.h" +/* Cache used during font lookup. It contains an opened font object + we can look inside, and some previously determined information. */ +struct font_object_cache_bucket +{ + struct font_object_cache_bucket *next; + unsigned int hash; + + BFont *font_object; +}; + +static struct font_object_cache_bucket *font_object_cache[2048]; + /* Haiku doesn't expose font language data in BFont objects. Thus, we select a few representative characters for each supported `:lang' (currently Chinese, Korean and Japanese,) and test for those instead. */ -static uint32_t language_code_points[MAX_LANGUAGE][4] = - {{20154, 20754, 22996, 0}, /* Chinese. */ - {51312, 49440, 44544, 0}, /* Korean. */ - {26085, 26412, 12371, 0}, /* Japanese. */}; +static int language_code_points[MAX_LANGUAGE][3] = + {{20154, 20754, 22996}, /* Chinese. */ + {51312, 49440, 44544}, /* Korean. */ + {26085, 26412, 12371}, /* Japanese. */}; + +static unsigned int +hash_string (const char *name_or_style) +{ + unsigned int i; + + i = 3323198485ul; + for (; *name_or_style; ++name_or_style) + { + i ^= *name_or_style; + i *= 0x5bd1e995; + i ^= i >> 15; + } + return i; +} + +static struct font_object_cache_bucket * +cache_font_object_data (const char *family, const char *style, + BFont *font_object) +{ + uint32_t hash; + struct font_object_cache_bucket *bucket, *next; + + hash = hash_string (family) ^ hash_string (style); + bucket = font_object_cache[hash % 2048]; + + for (next = bucket; next; next = next->next) + { + if (next->hash == hash) + { + delete next->font_object; + next->font_object = font_object; + + return next; + } + } + + next = new struct font_object_cache_bucket; + next->font_object = font_object; + next->hash = hash; + next->next = bucket; + font_object_cache[hash % 2048] = next; + return next; +} + +static struct font_object_cache_bucket * +lookup_font_object_data (const char *family, const char *style) +{ + uint32_t hash; + struct font_object_cache_bucket *bucket, *next; + + hash = hash_string (family) ^ hash_string (style); + bucket = font_object_cache[hash % 2048]; + + for (next = bucket; next; next = next->next) + { + if (next->hash == hash) + return next; + } + + return NULL; +} + +static bool +font_object_has_chars (struct font_object_cache_bucket *cached, + int *chars, int nchars, bool just_one_of) +{ + int i; + + for (i = 0; i < nchars; ++i) + { + if (just_one_of + && cached->font_object->IncludesBlock (chars[i], + chars[i])) + return true; + + if (!just_one_of + && !cached->font_object->IncludesBlock (chars[i], + chars[i])) + return false; + } + + return !just_one_of; +} static void estimate_font_ascii (BFont *font, int *max_width, @@ -85,9 +181,9 @@ BFont_close (void *font) } void -BFont_dat (void *font, int *px_size, int *min_width, int *max_width, - int *avg_width, int *height, int *space_width, int *ascent, - int *descent, int *underline_position, int *underline_thickness) +BFont_metrics (void *font, int *px_size, int *min_width, int *max_width, + int *avg_width, int *height, int *space_width, int *ascent, + int *descent, int *underline_position, int *underline_thickness) { BFont *ft = (BFont *) font; struct font_height fheight; @@ -196,18 +292,21 @@ font_style_to_flags (char *st, struct haiku_font_pattern *pattern) { char *style = strdup (st); char *token; - pattern->weight = -1; + int tok = 0; + + if (!style) + return; + + pattern->weight = NO_WEIGHT; pattern->width = NO_WIDTH; pattern->slant = NO_SLANT; - int tok = 0; while ((token = std::strtok (!tok ? style : NULL, " ")) && tok < 3) { if (token && !strcmp (token, "Thin")) pattern->weight = HAIKU_THIN; - else if (token && !strcmp (token, "UltraLight")) - pattern->weight = HAIKU_ULTRALIGHT; - else if (token && !strcmp (token, "ExtraLight")) + else if (token && (!strcmp (token, "UltraLight") + || !strcmp (token, "ExtraLight"))) pattern->weight = HAIKU_EXTRALIGHT; else if (token && !strcmp (token, "Light")) pattern->weight = HAIKU_LIGHT; @@ -221,7 +320,7 @@ font_style_to_flags (char *st, struct haiku_font_pattern *pattern) if (pattern->width == NO_WIDTH) pattern->width = NORMAL_WIDTH; - if (pattern->weight == -1) + if (pattern->weight == NO_WEIGHT) pattern->weight = HAIKU_REGULAR; } else if (token && (!strcmp (token, "SemiBold") @@ -230,12 +329,11 @@ font_style_to_flags (char *st, struct haiku_font_pattern *pattern) pattern->weight = HAIKU_SEMI_BOLD; else if (token && !strcmp (token, "Bold")) pattern->weight = HAIKU_BOLD; - else if (token && (!strcmp (token, "ExtraBold") || + else if (token && (!strcmp (token, "ExtraBold") /* This has actually been seen in the wild. */ - !strcmp (token, "Extrabold"))) + || !strcmp (token, "Extrabold") + || !strcmp (token, "UltraBold"))) pattern->weight = HAIKU_EXTRA_BOLD; - else if (token && !strcmp (token, "UltraBold")) - pattern->weight = HAIKU_ULTRA_BOLD; else if (token && !strcmp (token, "Book")) pattern->weight = HAIKU_BOOK; else if (token && !strcmp (token, "Heavy")) @@ -274,7 +372,7 @@ font_style_to_flags (char *st, struct haiku_font_pattern *pattern) tok++; } - if (pattern->weight != -1) + if (pattern->weight != NO_WEIGHT) pattern->specified |= FSPEC_WEIGHT; if (pattern->slant != NO_SLANT) pattern->specified |= FSPEC_SLANT; @@ -299,54 +397,86 @@ static bool font_check_wanted_chars (struct haiku_font_pattern *pattern, font_family family, char *style) { - BFont ft; + BFont *ft; + static struct font_object_cache_bucket *cached; + unicode_block wanted_block; - if (ft.SetFamilyAndStyle (family, style) != B_OK) - return false; + cached = lookup_font_object_data (family, style); + if (cached) + ft = cached->font_object; + else + { + ft = new BFont; + + if (ft->SetFamilyAndStyle (family, style) != B_OK) + { + delete ft; + return false; + } - for (int i = 0; i < pattern->want_chars_len; ++i) - if (!ft.IncludesBlock (pattern->wanted_chars[i], - pattern->wanted_chars[i])) - return false; + cached = cache_font_object_data (family, style, ft); + } - return true; + return font_object_has_chars (cached, pattern->wanted_chars, + pattern->want_chars_len, false); } static bool font_check_one_of (struct haiku_font_pattern *pattern, font_family family, char *style) { - BFont ft; + BFont *ft; + static struct font_object_cache_bucket *cached; + unicode_block wanted_block; - if (ft.SetFamilyAndStyle (family, style) != B_OK) - return false; + cached = lookup_font_object_data (family, style); + if (cached) + ft = cached->font_object; + else + { + ft = new BFont; - for (int i = 0; i < pattern->need_one_of_len; ++i) - if (ft.IncludesBlock (pattern->need_one_of[i], - pattern->need_one_of[i])) - return true; + if (ft->SetFamilyAndStyle (family, style) != B_OK) + { + delete ft; + return false; + } - return false; + cached = cache_font_object_data (family, style, ft); + } + + return font_object_has_chars (cached, pattern->need_one_of, + pattern->need_one_of_len, true); } static bool font_check_language (struct haiku_font_pattern *pattern, font_family family, char *style) { - BFont ft; + BFont *ft; + static struct font_object_cache_bucket *cached; - if (ft.SetFamilyAndStyle (family, style) != B_OK) - return false; + cached = lookup_font_object_data (family, style); + if (cached) + ft = cached->font_object; + else + { + ft = new BFont; + + if (ft->SetFamilyAndStyle (family, style) != B_OK) + { + delete ft; + return false; + } + + cached = cache_font_object_data (family, style, ft); + } if (pattern->language == MAX_LANGUAGE) return false; - for (uint32_t *ch = (uint32_t *) - &language_code_points[pattern->language]; *ch; ch++) - if (!ft.IncludesBlock (*ch, *ch)) - return false; - - return true; + return font_object_has_chars (cached, language_code_points[pattern->language], + 3, false); } static bool @@ -360,16 +490,20 @@ font_family_style_matches_p (font_family family, char *style, uint32_t flags, if (style) font_style_to_flags (style, &m); - if ((pattern->specified & FSPEC_FAMILY) && - strcmp ((char *) &pattern->family, family)) + if ((pattern->specified & FSPEC_FAMILY) + && strcmp ((char *) &pattern->family, family)) return false; - if (!ignore_flags_p && (pattern->specified & FSPEC_SPACING) && - !(pattern->mono_spacing_p) != !(flags & B_IS_FIXED)) + if (!ignore_flags_p && (pattern->specified & FSPEC_SPACING) + && !(pattern->mono_spacing_p) != !(flags & B_IS_FIXED)) return false; if (pattern->specified & FSPEC_STYLE) return style && !strcmp (style, pattern->style); + /* Don't allow matching fonts with an adstyle if no style was + specified in the query pattern. */ + else if (m.specified & FSPEC_STYLE) + return false; if ((pattern->specified & FSPEC_WEIGHT) && (pattern->weight @@ -378,7 +512,8 @@ font_family_style_matches_p (font_family family, char *style, uint32_t flags, if ((pattern->specified & FSPEC_SLANT) && (pattern->slant - != ((m.specified & FSPEC_SLANT) ? m.slant : SLANT_REGULAR))) + != (m.specified & FSPEC_SLANT + ? m.slant : SLANT_REGULAR))) return false; if ((pattern->specified & FSPEC_WANTED) @@ -386,8 +521,9 @@ font_family_style_matches_p (font_family family, char *style, uint32_t flags, return false; if ((pattern->specified & FSPEC_WIDTH) - && (pattern->width != - ((m.specified & FSPEC_WIDTH) ? m.width : NORMAL_WIDTH))) + && (pattern->width + != (m.specified & FSPEC_WIDTH + ? m.width : NORMAL_WIDTH))) return false; if ((pattern->specified & FSPEC_NEED_ONE_OF) @@ -438,18 +574,21 @@ BFont_find (struct haiku_font_pattern *pt) font_family name; font_style sname; uint32 flags; - int sty_count; - int fam_count = count_font_families (); + int sty_count, fam_count, si, fi; + struct haiku_font_pattern *p, *head, *n; + bool oblique_seen_p; + + fam_count = count_font_families (); - for (int fi = 0; fi < fam_count; ++fi) + for (fi = 0; fi < fam_count; ++fi) { if (get_font_family (fi, &name, &flags) == B_OK) { sty_count = count_font_styles (name); - if (!sty_count && - font_family_style_matches_p (name, NULL, flags, pt)) + if (!sty_count + && font_family_style_matches_p (name, NULL, flags, pt)) { - struct haiku_font_pattern *p = new struct haiku_font_pattern; + p = new struct haiku_font_pattern; p->specified = 0; p->oblique_seen_p = 1; haiku_font_fill_pattern (p, name, NULL, flags); @@ -462,11 +601,11 @@ BFont_find (struct haiku_font_pattern *pt) } else if (sty_count) { - for (int si = 0; si < sty_count; ++si) + for (si = 0; si < sty_count; ++si) { - int oblique_seen_p = 0; - struct haiku_font_pattern *head = r; - struct haiku_font_pattern *p = NULL; + oblique_seen_p = 0; + head = r; + p = NULL; if (get_font_style (name, si, &sname, &flags) == B_OK) { @@ -475,8 +614,18 @@ BFont_find (struct haiku_font_pattern *pt) p = new struct haiku_font_pattern; p->specified = 0; haiku_font_fill_pattern (p, name, (char *) &sname, flags); - if (p->specified & FSPEC_SLANT && - ((p->slant == SLANT_OBLIQUE) || (p->slant == SLANT_ITALIC))) + + /* Add the indices to this font now so we + won't have to loop over each font in + order to open it later. */ + + p->specified |= FSPEC_INDICES; + p->family_index = fi; + p->style_index = si; + + if (p->specified & FSPEC_SLANT + && (p->slant == SLANT_OBLIQUE + || p->slant == SLANT_ITALIC)) oblique_seen_p = 1; p->next = r; @@ -491,9 +640,7 @@ BFont_find (struct haiku_font_pattern *pt) p->last = NULL; for (; head; head = head->last) - { - head->oblique_seen_p = oblique_seen_p; - } + head->oblique_seen_p = oblique_seen_p; } } } @@ -506,13 +653,18 @@ BFont_find (struct haiku_font_pattern *pt) if (!(pt->specified & FSPEC_SLANT)) { /* r->last is invalid from here onwards. */ - for (struct haiku_font_pattern *p = r; p;) + for (p = r; p;) { if (!p->oblique_seen_p) { - struct haiku_font_pattern *n = new haiku_font_pattern; + n = new haiku_font_pattern; *n = *p; + n->slant = SLANT_OBLIQUE; + + /* Opening a font by its indices doesn't provide enough + information to synthesize the oblique font later. */ + n->specified &= ~FSPEC_INDICES; p->next = n; p = p->next_family; } @@ -524,26 +676,68 @@ BFont_find (struct haiku_font_pattern *pt) return r; } +/* Find and open a font with the family at FAMILY and the style at + STYLE, and set its size to SIZE. Value is NULL if opening the font + failed. */ +void * +be_open_font_at_index (int family, int style, float size) +{ + font_family family_name; + font_style style_name; + uint32 flags; + status_t rc; + BFont *font; + + rc = get_font_family (family, &family_name, &flags); + + if (rc != B_OK) + return NULL; + + rc = get_font_style (family_name, style, &style_name, &flags); + + if (rc != B_OK) + return NULL; + + font = new BFont; + + rc = font->SetFamilyAndStyle (family_name, style_name); + + if (rc != B_OK) + { + delete font; + return NULL; + } + + font->SetSize (size); + font->SetEncoding (B_UNICODE_UTF8); + font->SetSpacing (B_BITMAP_SPACING); + return font; +} + /* Find and open a font matching the pattern PAT, which must have its family set. */ int BFont_open_pattern (struct haiku_font_pattern *pat, void **font, float size) { - int sty_count; + int sty_count, si, code; font_family name; font_style sname; + BFont *ft; uint32 flags = 0; + struct haiku_font_pattern copy; + if (!(pat->specified & FSPEC_FAMILY)) return 1; + strncpy (name, pat->family, sizeof name - 1); name[sizeof name - 1] = '\0'; sty_count = count_font_styles (name); - if (!sty_count && - font_family_style_matches_p (name, NULL, flags, pat, 1)) + if (!sty_count + && font_family_style_matches_p (name, NULL, flags, pat, 1)) { - BFont *ft = new BFont; + ft = new BFont; ft->SetSize (size); ft->SetEncoding (B_UNICODE_UTF8); ft->SetSpacing (B_BITMAP_SPACING); @@ -558,12 +752,13 @@ BFont_open_pattern (struct haiku_font_pattern *pat, void **font, float size) } else if (sty_count) { - for (int si = 0; si < sty_count; ++si) + for (si = 0; si < sty_count; ++si) { - if (get_font_style (name, si, &sname, &flags) == B_OK && - font_family_style_matches_p (name, (char *) &sname, flags, pat)) + if (get_font_style (name, si, &sname, &flags) == B_OK + && font_family_style_matches_p (name, (char *) &sname, + flags, pat)) { - BFont *ft = new BFont; + ft = new BFont; ft->SetSize (size); ft->SetEncoding (B_UNICODE_UTF8); ft->SetSpacing (B_BITMAP_SPACING); @@ -573,6 +768,7 @@ BFont_open_pattern (struct haiku_font_pattern *pat, void **font, float size) delete ft; return 1; } + *font = (void *) ft; return 0; } @@ -581,12 +777,14 @@ BFont_open_pattern (struct haiku_font_pattern *pat, void **font, float size) if (pat->specified & FSPEC_SLANT && pat->slant == SLANT_OBLIQUE) { - struct haiku_font_pattern copy = *pat; + copy = *pat; copy.slant = SLANT_REGULAR; - int code = BFont_open_pattern (©, font, size); + code = BFont_open_pattern (©, font, size); + if (code) return code; - BFont *ft = (BFont *) *font; + + ft = (BFont *) *font; /* XXX Font measurements don't respect shear. Haiku bug? This apparently worked in BeOS. ft->SetShear (100.0); */ @@ -622,12 +820,6 @@ BFont_populate_plain_family (struct haiku_font_pattern *ptn) ptn->family[sizeof ptn->family - 1] = '\0'; } -int -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) { @@ -651,3 +843,76 @@ be_list_font_families (size_t *length) return array; } + +void +be_init_font_data (void) +{ + memset (&font_object_cache, 0, sizeof font_object_cache); +} + +/* Free the font object cache. This is called every 50 updates of a + frame. */ +void +be_evict_font_cache (void) +{ + struct font_object_cache_bucket *bucket, *last; + int i; + + for (i = 0; i < 2048; ++i) + { + bucket = font_object_cache[i]; + + while (bucket) + { + last = bucket; + bucket = bucket->next; + delete last->font_object; + delete last; + } + + font_object_cache[i] = NULL; + } +} + +void +be_font_style_to_flags (char *style, struct haiku_font_pattern *pattern) +{ + pattern->specified = 0; + + font_style_to_flags (style, pattern); +} + +int +be_find_font_indices (struct haiku_font_pattern *pattern, + int *family_index, int *style_index) +{ + int32 i, j, n_families, n_styles; + font_family family; + font_style style; + uint32 flags; + + n_families = count_font_families (); + + for (i = 0; i < n_families; ++i) + { + if (get_font_family (i, &family, &flags) == B_OK) + { + n_styles = count_font_styles (family); + + for (j = 0; j < n_styles; ++j) + { + if (get_font_style (family, j, &style, &flags) == B_OK + && font_family_style_matches_p (family, style, + flags, pattern)) + { + *family_index = i; + *style_index = j; + + return 0; + } + } + } + } + + return 1; +} diff --git a/src/haiku_io.c b/src/haiku_io.c index 89f0877eb67..5d0031ef712 100644 --- a/src/haiku_io.c +++ b/src/haiku_io.c @@ -40,10 +40,15 @@ port_id port_application_to_emacs; thread to Emacs. */ port_id port_popup_menu_to_emacs; +/* The port used to send replies to the application after a session + management event. */ +port_id port_emacs_to_session_manager; + void haiku_io_init (void) { port_application_to_emacs = create_port (PORT_CAP, "application emacs port"); + port_emacs_to_session_manager = create_port (1, "session manager port"); } static ssize_t @@ -79,13 +84,13 @@ haiku_len (enum haiku_event_type type) return sizeof (struct haiku_wheel_move_event); case MENU_BAR_RESIZE: return sizeof (struct haiku_menu_bar_resize_event); + case MENU_BAR_CLICK: + return sizeof (struct haiku_menu_bar_click_event); case MENU_BAR_OPEN: case MENU_BAR_CLOSE: return sizeof (struct haiku_menu_bar_state_event); case MENU_BAR_SELECT_EVENT: return sizeof (struct haiku_menu_bar_select_event); - case FILE_PANEL_EVENT: - return sizeof (struct haiku_file_panel_event); case MENU_BAR_HELP_EVENT: return sizeof (struct haiku_menu_bar_help_event); case ZOOM_EVENT: @@ -202,24 +207,3 @@ haiku_io_init_in_app_thread (void) if (pthread_sigmask (SIG_BLOCK, &set, NULL)) perror ("pthread_sigmask"); } - -/* Record an unwind protect from C++ code. */ -void -record_c_unwind_protect_from_cxx (void (*fn) (void *), void *r) -{ - record_unwind_protect_ptr (fn, r); -} - -/* SPECPDL_IDX that is safe from C++ code. */ -specpdl_ref -c_specpdl_idx_from_cxx (void) -{ - return SPECPDL_INDEX (); -} - -/* unbind_to (IDX, Qnil), but safe from C++ code. */ -void -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 be8026b6a16..a26a0049cbf 100644 --- a/src/haiku_select.cc +++ b/src/haiku_select.cc @@ -35,8 +35,6 @@ static int64 count_clipboard = -1; static int64 count_primary = -1; static int64 count_secondary = -1; -int selection_state_flag; - static char * BClipboard_find_data (BClipboard *cb, const char *type, ssize_t *len) { diff --git a/src/haiku_support.cc b/src/haiku_support.cc index cb38a572f7c..0ab31bc98dc 100644 --- a/src/haiku_support.cc +++ b/src/haiku_support.cc @@ -38,6 +38,13 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <interface/Button.h> #include <interface/ControlLook.h> #include <interface/Deskbar.h> +#include <interface/ListView.h> +#include <interface/StringItem.h> +#include <interface/SplitView.h> +#include <interface/ScrollView.h> +#include <interface/StringView.h> +#include <interface/TextControl.h> +#include <interface/CheckBox.h> #include <locale/UnicodeChar.h> @@ -54,6 +61,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <support/Beep.h> #include <support/DataIO.h> #include <support/Locker.h> +#include <support/ObjectList.h> #include <translation/TranslatorRoster.h> #include <translation/TranslationDefs.h> @@ -81,14 +89,72 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include "haiku_support.h" +/* Some messages that Emacs sends to itself. */ enum { - SCROLL_BAR_UPDATE = 3000, - WAIT_FOR_RELEASE = 3001, - RELEASE_NOW = 3002, - CANCEL_DROP = 3003, + SCROLL_BAR_UPDATE = 3000, + WAIT_FOR_RELEASE = 3001, + RELEASE_NOW = 3002, + CANCEL_DROP = 3003, + SHOW_MENU_BAR = 3004, + BE_MENU_BAR_OPEN = 3005, + QUIT_APPLICATION = 3006, + REPLAY_MENU_BAR = 3007, + FONT_FAMILY_SELECTED = 3008, + FONT_STYLE_SELECTED = 3009, + FILE_PANEL_SELECTION = 3010, + QUIT_PREVIEW_DIALOG = 3011, + SET_FONT_INDICES = 3012, + SET_PREVIEW_DIALOG = 3013, + UPDATE_PREVIEW_DIALOG = 3014, }; +/* X11 keysyms that we use. */ +enum + { + KEY_BACKSPACE = 0xff08, + KEY_TAB = 0xff09, + KEY_RETURN = 0xff0d, + KEY_PAUSE = 0xff13, + KEY_ESCAPE = 0xff1b, + KEY_DELETE = 0xffff, + KEY_HOME = 0xff50, + KEY_LEFT_ARROW = 0xff51, + KEY_UP_ARROW = 0xff52, + KEY_RIGHT_ARROW = 0xff53, + KEY_DOWN_ARROW = 0xff54, + KEY_PAGE_UP = 0xff55, + KEY_PAGE_DOWN = 0xff56, + KEY_END = 0xff57, + KEY_PRINT = 0xff61, + KEY_INSERT = 0xff63, + /* This is used to indicate the first function key. */ + KEY_F1 = 0xffbe, + /* These are found on some multilingual keyboards. */ + KEY_HANGUL = 0xff31, + KEY_HANGUL_HANJA = 0xff34, + KEY_HIRIGANA_KATAGANA = 0xff27, + KEY_ZENKAKU_HANKAKU = 0xff2a, + }; + +struct font_selection_dialog_message +{ + /* Whether or not font selection was cancelled. */ + bool_bf cancel : 1; + + /* Whether or not a size was explictly specified. */ + bool_bf size_specified : 1; + + /* The index of the selected font family. */ + int family_idx; + + /* The index of the selected font style. */ + int style_idx; + + /* The selected font size. */ + int size; +}; + static color_space dpy_color_space = B_NO_COLOR_SPACE; static key_map *key_map = NULL; static char *key_chars = NULL; @@ -129,17 +195,38 @@ static void *grab_view = NULL; static BLocker grab_view_locker; static bool drag_and_drop_in_progress; +/* Port used to send data to the main thread while a file panel is + active. */ +static port_id volatile current_file_panel_port; + +/* Many places require us to lock the child frame data, and then lock + the locker of some random window. Unfortunately, locking such a + window might be delayed due to an arriving message, which then + calls a callback inside that window that tries to lock the child + frame data but doesn't finish since the child frame lock is already + held, not letting the code that held the child frame lock proceed, + thereby causing a deadlock. + + Rectifying that problem is simple: all code in a looper callback + must lock the child frame data with this macro instead. + + IOW, if some other code is already running with the child frame + lock held, don't interfere: wait until it's finished before + continuing. */ +#define CHILD_FRAME_LOCK_INSIDE_LOOPER_CALLBACK \ + if (child_frame_lock.LockWithTimeout (200) != B_OK) \ + { \ + /* The Haiku equivalent of XPutBackEvent. */ \ + if (CurrentMessage ()) \ + PostMessage (CurrentMessage ()); \ + } \ + else + /* 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 *); -extern "C" -{ - extern _Noreturn void emacs_abort (void); - /* Also defined in haikuterm.h. */ - extern void be_app_quit (void); -} - +/* The ID of the thread the BApplication is running in. */ static thread_id app_thread; _Noreturn void @@ -149,7 +236,7 @@ gui_abort (const char *msg) fprintf (stderr, "Under Haiku, Emacs cannot recover from errors in GUI code\n"); fprintf (stderr, "App Server disconnects usually manifest as bitmap " "initialization failures or lock failures."); - emacs_abort (); + abort (); } struct be_popup_menu_data @@ -193,65 +280,78 @@ keysym_from_raw_char (int32 raw, int32 key, unsigned *code) switch (raw) { case B_BACKSPACE: - *code = XK_BackSpace; + *code = KEY_BACKSPACE; break; case B_RETURN: - *code = XK_Return; + *code = KEY_RETURN; break; case B_TAB: - *code = XK_Tab; + *code = KEY_TAB; break; case B_ESCAPE: - *code = XK_Escape; + *code = KEY_ESCAPE; break; case B_LEFT_ARROW: - *code = XK_Left; + *code = KEY_LEFT_ARROW; break; case B_RIGHT_ARROW: - *code = XK_Right; + *code = KEY_RIGHT_ARROW; break; case B_UP_ARROW: - *code = XK_Up; + *code = KEY_UP_ARROW; break; case B_DOWN_ARROW: - *code = XK_Down; + *code = KEY_DOWN_ARROW; break; case B_INSERT: - *code = XK_Insert; + *code = KEY_INSERT; break; case B_DELETE: - *code = XK_Delete; + *code = KEY_DELETE; break; case B_HOME: - *code = XK_Home; + *code = KEY_HOME; break; case B_END: - *code = XK_End; + *code = KEY_END; break; case B_PAGE_UP: - *code = XK_Page_Up; + *code = KEY_PAGE_UP; break; case B_PAGE_DOWN: - *code = XK_Page_Down; + *code = KEY_PAGE_DOWN; break; case B_FUNCTION_KEY: - *code = XK_F1 + key - 2; + *code = KEY_F1 + key - 2; - if (*code - XK_F1 == 12) - *code = XK_Print; - else if (*code - XK_F1 == 13) + if (*code - KEY_F1 == 12) + *code = KEY_PRINT; + else if (*code - KEY_F1 == 13) /* Okay, Scroll Lock is a bit too much: keyboard.c doesn't know about it yet, and it shouldn't, since that's a modifier key. - *code = XK_Scroll_Lock; */ + *code = KEY_SCROLL_LOCK; */ return -1; - else if (*code - XK_F1 == 14) - *code = XK_Pause; + else if (*code - KEY_F1 == 14) + *code = KEY_PAUSE; break; + case B_HANGUL: + *code = KEY_HANGUL; + break; + case B_HANGUL_HANJA: + *code = KEY_HANGUL_HANJA; + break; + case B_KATAKANA_HIRAGANA: + *code = KEY_HIRIGANA_KATAGANA; + break; + case B_HANKAKU_ZENKAKU: + *code = KEY_ZENKAKU_HANKAKU; + break; + default: return 0; } @@ -390,8 +490,27 @@ public: QuitRequested (void) { struct haiku_app_quit_requested_event rq; + struct haiku_session_manager_reply reply; + int32 reply_type; + haiku_write (APP_QUIT_REQUESTED_EVENT, &rq); - return 0; + + if (read_port (port_emacs_to_session_manager, + &reply_type, &reply, sizeof reply) < B_OK) + /* Return true so the system kills us, since there's no real + alternative if this read fails. */ + return true; + + return reply.quit_reply; + } + + void + MessageReceived (BMessage *msg) + { + if (msg->what == QUIT_APPLICATION) + Quit (); + else + BApplication::MessageReceived (msg); } }; @@ -419,15 +538,16 @@ public: 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; int window_id; + bool *menus_begun = NULL; + enum haiku_z_group z_group; + bool tooltip_p = false; EmacsWindow () : BWindow (BRect (0, 0, 0, 0), "", B_TITLED_WINDOW_LOOK, B_NORMAL_WINDOW_FEEL, B_NO_SERVER_SIDE_WINDOW_MODIFIERS) { window_id = current_window_id++; + z_group = Z_GROUP_NONE; /* This pulse rate is used by scroll bars for repeating a button action while a button is held down. */ @@ -452,9 +572,19 @@ public: if (this->parent) UnparentAndUnlink (); child_frame_lock.Unlock (); + } - pthread_cond_destroy (&menu_update_cv); - pthread_mutex_destroy (&menu_update_mutex); + void + RecomputeFeel (void) + { + if (override_redirect_p || tooltip_p) + SetFeel (kMenuWindowFeel); + else if (parent) + SetFeel (B_FLOATING_SUBSET_WINDOW_FEEL); + else if (z_group == Z_GROUP_ABOVE) + SetFeel (B_FLOATING_ALL_WINDOW_FEEL); + else + SetFeel (B_NORMAL_WINDOW_FEEL); } BRect @@ -474,8 +604,7 @@ public: screen_frame = frame = screen.Frame (); deskbar_frame = deskbar.Frame (); - if (!(modifiers () & B_SHIFT_KEY) - && !deskbar.IsAutoHide ()) + if (!(modifiers () & B_SHIFT_KEY) && !deskbar.IsAutoHide ()) { switch (deskbar.Location ()) { @@ -486,13 +615,14 @@ public: case B_DESKBAR_BOTTOM: case B_DESKBAR_LEFT_BOTTOM: case B_DESKBAR_RIGHT_BOTTOM: - frame.bottom = deskbar_frame.bottom - 2; + frame.bottom = deskbar_frame.top - 2; break; case B_DESKBAR_LEFT_TOP: - if (deskbar.IsExpanded ()) + if (!deskbar.IsExpanded ()) frame.top = deskbar_frame.bottom + 2; - else + else if (!deskbar.IsAlwaysOnTop () + && !deskbar.IsAutoRaise ()) frame.left = deskbar_frame.right + 2; break; @@ -522,7 +652,7 @@ public: frame.left = screen_frame.left + (window_frame.left - decorator_frame.left); frame.right = screen_frame.right - (decorator_frame.right - - window_frame.left); + - window_frame.right); } return frame; @@ -575,12 +705,17 @@ public: void Unparent (void) { + EmacsWindow *parent; + if (!child_frame_lock.Lock ()) gui_abort ("Failed to lock child frame state lock"); - this->SetFeel (B_NORMAL_WINDOW_FEEL); + + parent = this->parent; + this->parent = NULL; + RecomputeFeel (); UpwardsUnSubsetChildren (parent); this->RemoveFromSubset (this); - this->parent = NULL; + if (fullscreen_p) { fullscreen_p = 0; @@ -631,7 +766,7 @@ public: UnparentAndUnlink (); this->parent = window; - this->SetFeel (B_FLOATING_SUBSET_WINDOW_FEEL); + RecomputeFeel (); this->AddToSubset (this); if (!IsHidden () && this->parent) UpwardsSubsetChildren (parent); @@ -751,46 +886,48 @@ public: haiku_write (MENU_BAR_SELECT_EVENT, &rq); } - else if (msg->what == 'FPSE' + else if (msg->what == FILE_PANEL_SELECTION || ((msg->FindInt32 ("old_what", &old_what) == B_OK - && old_what == 'FPSE'))) + && old_what == FILE_PANEL_SELECTION))) { - struct haiku_file_panel_event rq; + const char *str_path, *name; + char *file_name, *str_buf; BEntry entry; BPath path; entry_ref ref; - rq.ptr = NULL; + file_name = NULL; if (msg->FindRef ("refs", &ref) == B_OK && entry.SetTo (&ref, 0) == B_OK && entry.GetPath (&path) == B_OK) { - const char *str_path = path.Path (); + str_path = path.Path (); + if (str_path) - rq.ptr = strdup (str_path); + file_name = strdup (str_path); } if (msg->FindRef ("directory", &ref), entry.SetTo (&ref, 0) == B_OK && entry.GetPath (&path) == B_OK) { - const char *name = msg->GetString ("name"); - const char *str_path = path.Path (); + name = msg->GetString ("name"); + str_path = path.Path (); if (name) { - char str_buf[std::strlen (str_path) - + std::strlen (name) + 2]; - snprintf ((char *) &str_buf, - std::strlen (str_path) + str_buf = (char *) alloca (std::strlen (str_path) + + std::strlen (name) + 2); + snprintf (str_buf, std::strlen (str_path) + std::strlen (name) + 2, "%s/%s", str_path, name); - rq.ptr = strdup (str_buf); + file_name = strdup (str_buf); } } - haiku_write (FILE_PANEL_EVENT, &rq); + write_port (current_file_panel_port, 0, + &file_name, sizeof file_name); } else BWindow::MessageReceived (msg); @@ -899,39 +1036,16 @@ public: } void - MenusBeginning () + MenusBeginning (void) { 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); + rq.window = this; + if (!menus_begun) + haiku_write (MENU_BAR_OPEN, &rq); + else + *menus_begun = true; - 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; } @@ -967,25 +1081,28 @@ public: haiku_write (MOVE_EVENT, &rq); - if (!child_frame_lock.Lock ()) - gui_abort ("Failed to lock child frame state lock"); - for (struct child_frame *f = subset_windows; - f; f = f->next) - DoMove (f); - child_frame_lock.Unlock (); + CHILD_FRAME_LOCK_INSIDE_LOOPER_CALLBACK + { + for (struct child_frame *f = subset_windows; + f; f = f->next) + DoMove (f); + child_frame_lock.Unlock (); - BWindow::FrameMoved (newPosition); + BWindow::FrameMoved (newPosition); + } } void WorkspacesChanged (uint32_t old, uint32_t n) { - if (!child_frame_lock.Lock ()) - gui_abort ("Failed to lock child frames for changing workspaces"); - for (struct child_frame *f = subset_windows; - f; f = f->next) - DoUpdateWorkspace (f); - child_frame_lock.Unlock (); + CHILD_FRAME_LOCK_INSIDE_LOOPER_CALLBACK + { + for (struct child_frame *f = subset_windows; + f; f = f->next) + DoUpdateWorkspace (f); + + child_frame_lock.Unlock (); + } } void @@ -1013,12 +1130,13 @@ public: void Minimize (bool minimized_p) { - BWindow::Minimize (minimized_p); struct haiku_iconification_event rq; + rq.window = this; rq.iconified_p = !parent && minimized_p; - haiku_write (ICONIFICATION, &rq); + + BWindow::Minimize (minimized_p); } void @@ -1199,6 +1317,8 @@ public: class EmacsMenuBar : public BMenuBar { + bool tracking_p; + public: EmacsMenuBar () : BMenuBar (BRect (0, 0, 0, 0), NULL) { @@ -1217,14 +1337,30 @@ public: { struct haiku_menu_bar_resize_event rq; rq.window = this->Window (); - rq.height = std::lrint (newHeight); - rq.width = std::lrint (newWidth); + rq.height = std::lrint (newHeight + 1); + rq.width = std::lrint (newWidth + 1); haiku_write (MENU_BAR_RESIZE, &rq); BMenuBar::FrameResized (newWidth, newHeight); } void + MouseDown (BPoint point) + { + struct haiku_menu_bar_click_event rq; + EmacsWindow *ew = (EmacsWindow *) Window (); + + rq.window = ew; + rq.x = std::lrint (point.x); + rq.y = std::lrint (point.y); + + if (!ew->menu_bar_active_p) + haiku_write (MENU_BAR_CLICK, &rq); + else + BMenuBar::MouseDown (point); + } + + void MouseMoved (BPoint point, uint32 transit, const BMessage *msg) { struct haiku_menu_bar_left_event rq; @@ -1244,6 +1380,53 @@ public: BMenuBar::MouseMoved (point, transit, msg); } + + void + MessageReceived (BMessage *msg) + { + BRect frame; + BPoint pt, l; + EmacsWindow *window; + bool menus_begun; + + if (msg->what == SHOW_MENU_BAR) + { + window = (EmacsWindow *) Window (); + frame = Frame (); + pt = frame.LeftTop (); + l = pt; + menus_begun = false; + Parent ()->ConvertToScreen (&pt); + + window->menus_begun = &menus_begun; + set_mouse_position (pt.x, pt.y); + BMenuBar::MouseDown (l); + window->menus_begun = NULL; + + if (!menus_begun) + msg->SendReply (msg); + else + msg->SendReply (BE_MENU_BAR_OPEN); + } + else if (msg->what == REPLAY_MENU_BAR) + { + window = (EmacsWindow *) Window (); + menus_begun = false; + window->menus_begun = &menus_begun; + + if (msg->FindPoint ("emacs:point", &pt) == B_OK) + BMenuBar::MouseDown (pt); + + window->menus_begun = NULL; + + if (!menus_begun) + msg->SendReply (msg); + else + msg->SendReply (BE_MENU_BAR_OPEN); + } + else + BMenuBar::MessageReceived (msg); + } }; class EmacsView : public BView @@ -1267,8 +1450,6 @@ public: BPoint tt_absl_pos; BMessage *wait_for_release_message = NULL; - color_space cspace; - EmacsView () : BView (BRect (0, 0, 0, 0), "Emacs", B_FOLLOW_NONE, B_WILL_DRAW) { @@ -1292,12 +1473,6 @@ public: } void - AttachedToWindow (void) - { - cspace = B_RGBA32; - } - - void MessageReceived (BMessage *msg) { uint32 buttons; @@ -1408,7 +1583,7 @@ public: #endif offscreen_draw_view->RemoveSelf (); delete offscreen_draw_bitmap_1; - offscreen_draw_bitmap_1 = new BBitmap (Frame (), cspace, 1); + offscreen_draw_bitmap_1 = new BBitmap (Frame (), B_RGBA32, 1); if (offscreen_draw_bitmap_1->InitCheck () != B_OK) gui_abort ("Offscreen draw bitmap initialization failed"); @@ -1516,7 +1691,7 @@ public: if (offscreen_draw_view) gui_abort ("Failed to lock offscreen view setting up double buffering"); - offscreen_draw_bitmap_1 = new BBitmap (Frame (), cspace, 1); + offscreen_draw_bitmap_1 = new BBitmap (Frame (), B_RGBA32, 1); if (offscreen_draw_bitmap_1->InitCheck () != B_OK) gui_abort ("Failed to init offscreen bitmap"); #ifdef USE_BE_CAIRO @@ -1719,6 +1894,7 @@ public: int last_reported_overscroll_value; int max_value, real_max_value; int overscroll_start_value; + bigtime_t repeater_start; EmacsScrollBar (int x, int y, int x1, int y1, bool horizontal_p) : BScrollBar (BRect (x, y, x1, y1), NULL, NULL, 0, 0, horizontal_p ? @@ -1806,14 +1982,17 @@ public: return; } - GetMouse (&point, &buttons, false); - - if (ButtonRegionFor (current_part).Contains (point)) + if (repeater_start < system_time ()) { - rq.scroll_bar = this; - rq.window = Window (); - rq.part = current_part; - haiku_write (SCROLL_BAR_PART_EVENT, &rq); + GetMouse (&point, &buttons, false); + + if (ButtonRegionFor (current_part).Contains (point)) + { + rq.scroll_bar = this; + rq.window = Window (); + rq.part = current_part; + haiku_write (SCROLL_BAR_PART_EVENT, &rq); + } } BScrollBar::Pulse (); @@ -1947,6 +2126,8 @@ public: return; } + repeater_start = system_time () + 300000; + if (buttons == B_PRIMARY_MOUSE_BUTTON) { r = ButtonRegionFor (HAIKU_SCROLL_BAR_UP_BUTTON); @@ -2139,7 +2320,7 @@ public: menu->PushState (); menu->SetFont (be_bold_font); - BView_SetHighColorForVisibleBell (menu, 0); + menu->SetHighColor (ui_color (B_MENU_ITEM_TEXT_COLOR)); BMenuItem::DrawContent (); menu->PopState (); } @@ -2267,16 +2448,596 @@ public: } }; +class EmacsFontPreviewDialog : public BWindow +{ + BStringView text_view; + BMessenger preview_source; + BFont *current_font; + bool is_visible; + + void + DoLayout (void) + { + float width, height; + + text_view.GetPreferredSize (&width, &height); + text_view.ResizeTo (width - 1, height - 1); + + SetSizeLimits (width, width, height, height); + ResizeTo (width - 1, height - 1); + } + + bool + QuitRequested (void) + { + preview_source.SendMessage (QUIT_PREVIEW_DIALOG); + + return false; + } + + void + MessageReceived (BMessage *message) + { + int32 family, style; + uint32 flags; + font_family name; + font_style sname; + status_t rc; + const char *size_name; + int size; + + if (message->what == SET_FONT_INDICES) + { + size_name = message->FindString ("emacs:size"); + + if (message->FindInt32 ("emacs:family", &family) != B_OK + || message->FindInt32 ("emacs:style", &style) != B_OK) + return; + + rc = get_font_family (family, &name, &flags); + + if (rc != B_OK) + return; + + rc = get_font_style (name, style, &sname, &flags); + + if (rc != B_OK) + return; + + if (current_font) + delete current_font; + + current_font = new BFont; + current_font->SetFamilyAndStyle (name, sname); + + if (size_name && strlen (size_name)) + { + size = atoi (size_name); + current_font->SetSize (size); + } + + text_view.SetFont (current_font); + DoLayout (); + return; + } + + BWindow::MessageReceived (message); + } + +public: + + EmacsFontPreviewDialog (BWindow *target) + : BWindow (BRect (45, 45, 500, 300), + "Preview font", + B_FLOATING_WINDOW_LOOK, + B_MODAL_APP_WINDOW_FEEL, + B_NOT_ZOOMABLE | B_NOT_RESIZABLE), + text_view (BRect (0, 0, 0, 0), + NULL, "The quick brown fox " + "jumped over the lazy dog"), + preview_source (target), + current_font (NULL) + { + AddChild (&text_view); + DoLayout (); + } + + ~EmacsFontPreviewDialog (void) + { + text_view.RemoveSelf (); + + if (current_font) + delete current_font; + } +}; + +class DualLayoutView : public BView +{ + BScrollView *view_1; + BView *view_2; + + void + FrameResized (float new_width, float new_height) + { + BRect frame; + float width, height; + + frame = Frame (); + + view_2->GetPreferredSize (&width, &height); + + view_1->MoveTo (0, 0); + view_1->ResizeTo (BE_RECT_WIDTH (frame), + BE_RECT_HEIGHT (frame) - height); + view_2->MoveTo (2, BE_RECT_HEIGHT (frame) - height); + view_2->ResizeTo (BE_RECT_WIDTH (frame) - 4, height); + + BView::FrameResized (new_width, new_height); + } + + /* This is called by the BSplitView. */ + BSize + MinSize (void) + { + float width, height; + BSize size_1; + + size_1 = view_1->MinSize (); + view_2->GetPreferredSize (&width, &height); + + return BSize (std::max (size_1.width, width), + std::max (size_1.height, height)); + } + +public: + DualLayoutView (BScrollView *first, BView *second) : BView (NULL, B_FRAME_EVENTS), + view_1 (first), + view_2 (second) + { + FrameResized (801, 801); + } +}; + +class EmacsFontSelectionDialog : public BWindow +{ + BView basic_view; + BCheckBox preview_checkbox; + BSplitView split_view; + BListView font_family_pane; + BListView font_style_pane; + BScrollView font_family_scroller; + BScrollView font_style_scroller; + DualLayoutView style_view; + BObjectList<BStringItem> all_families; + BObjectList<BStringItem> all_styles; + BButton cancel_button, ok_button; + BTextControl size_entry; + port_id comm_port; + bool allow_monospace_only; + int pending_selection_idx; + EmacsFontPreviewDialog *preview; + + void + ShowPreview (void) + { + if (!preview) + { + preview = new EmacsFontPreviewDialog (this); + preview->Show (); + + UpdatePreview (); + } + } + + void + UpdatePreview (void) + { + int family, style; + BMessage message; + BMessenger messenger (preview); + + family = font_family_pane.CurrentSelection (); + style = font_style_pane.CurrentSelection (); + + message.what = SET_FONT_INDICES; + message.AddInt32 ("emacs:family", family); + message.AddInt32 ("emacs:style", style); + + message.AddString ("emacs:size", + size_entry.Text ()); + + messenger.SendMessage (&message); + } + + void + HidePreview (void) + { + if (preview) + { + if (preview->LockLooper ()) + preview->Quit (); + /* I hope this works. */ + else + delete preview; + + preview = NULL; + } + } + + void + UpdateStylesForIndex (int idx) + { + int n, i; + uint32 flags; + font_family family; + font_style style; + BStringItem *item; + + n = all_styles.CountItems (); + + font_style_pane.MakeEmpty (); + all_styles.MakeEmpty (); + + if (get_font_family (idx, &family, &flags) == B_OK) + { + n = count_font_styles (family); + + for (i = 0; i < n; ++i) + { + if (get_font_style (family, i, &style, &flags) == B_OK) + item = new BStringItem (style); + else + item = new BStringItem ("<error>"); + + font_style_pane.AddItem (item); + all_styles.AddItem (item); + } + } + + if (pending_selection_idx >= 0) + { + font_style_pane.Select (pending_selection_idx); + font_style_pane.ScrollToSelection (); + } + + pending_selection_idx = -1; + UpdateForSelectedStyle (); + } + + bool + QuitRequested (void) + { + struct font_selection_dialog_message rq; + + rq.cancel = true; + write_port (comm_port, 0, &rq, sizeof rq); + + return false; + } + + void + UpdateForSelectedStyle (void) + { + int style = font_style_pane.CurrentSelection (); + + if (style < 0) + ok_button.SetEnabled (false); + else + ok_button.SetEnabled (true); + + if (style >= 0 && preview) + UpdatePreview (); + } + + void + MessageReceived (BMessage *msg) + { + const char *text; + int idx; + struct font_selection_dialog_message rq; + + if (msg->what == FONT_FAMILY_SELECTED) + { + idx = font_family_pane.CurrentSelection (); + UpdateStylesForIndex (idx); + } + else if (msg->what == FONT_STYLE_SELECTED) + UpdateForSelectedStyle (); + else if (msg->what == B_OK + && font_style_pane.CurrentSelection () >= 0) + { + text = size_entry.Text (); + + rq.cancel = false; + rq.family_idx = font_family_pane.CurrentSelection (); + rq.style_idx = font_style_pane.CurrentSelection (); + rq.size = atoi (text); + rq.size_specified = rq.size > 0 || strlen (text); + + write_port (comm_port, 0, &rq, sizeof rq); + } + else if (msg->what == B_CANCEL) + { + rq.cancel = true; + + write_port (comm_port, 0, &rq, sizeof rq); + } + else if (msg->what == SET_PREVIEW_DIALOG) + { + if (preview_checkbox.Value () == B_CONTROL_OFF) + HidePreview (); + else + ShowPreview (); + } + else if (msg->what == QUIT_PREVIEW_DIALOG) + { + preview_checkbox.SetValue (B_CONTROL_OFF); + HidePreview (); + } + else if (msg->what == UPDATE_PREVIEW_DIALOG) + { + if (preview) + UpdatePreview (); + } + + BWindow::MessageReceived (msg); + } + +public: + + ~EmacsFontSelectionDialog (void) + { + if (preview) + { + if (preview->LockLooper ()) + preview->Quit (); + /* I hope this works. */ + else + delete preview; + } + + font_family_pane.MakeEmpty (); + font_style_pane.MakeEmpty (); + + font_family_pane.RemoveSelf (); + font_style_pane.RemoveSelf (); + preview_checkbox.RemoveSelf (); + style_view.RemoveSelf (); + font_family_scroller.RemoveSelf (); + font_style_scroller.RemoveSelf (); + cancel_button.RemoveSelf (); + ok_button.RemoveSelf (); + size_entry.RemoveSelf (); + basic_view.RemoveSelf (); + + if (comm_port >= B_OK) + delete_port (comm_port); + } + + EmacsFontSelectionDialog (bool monospace_only, + int initial_family_idx, + int initial_style_idx, + int initial_size) + : BWindow (BRect (0, 0, 500, 500), + "Select font from list", + B_TITLED_WINDOW_LOOK, + B_MODAL_APP_WINDOW_FEEL, 0), + basic_view (NULL, 0), + preview_checkbox ("Show preview", "Show preview", + new BMessage (SET_PREVIEW_DIALOG)), + font_family_pane (BRect (0, 0, 0, 0), NULL, + B_SINGLE_SELECTION_LIST, + B_FOLLOW_ALL_SIDES), + font_style_pane (BRect (0, 0, 0, 0), NULL, + B_SINGLE_SELECTION_LIST, + B_FOLLOW_ALL_SIDES), + font_family_scroller (NULL, &font_family_pane, + B_FOLLOW_LEFT | B_FOLLOW_TOP, + 0, false, true), + font_style_scroller (NULL, &font_style_pane, + B_FOLLOW_ALL_SIDES, + B_SUPPORTS_LAYOUT, false, true), + style_view (&font_style_scroller, &preview_checkbox), + all_families (20, true), + all_styles (20, true), + cancel_button ("Cancel", "Cancel", + new BMessage (B_CANCEL)), + ok_button ("OK", "OK", new BMessage (B_OK)), + size_entry (NULL, "Size:", NULL, + new BMessage (UPDATE_PREVIEW_DIALOG)), + allow_monospace_only (monospace_only), + pending_selection_idx (initial_style_idx), + preview (NULL) + { + BStringItem *family_item; + int i, n_families; + font_family name; + uint32 flags, c; + BMessage *selection; + BTextView *size_text; + char format_buffer[4]; + + AddChild (&basic_view); + + basic_view.AddChild (&split_view); + basic_view.AddChild (&cancel_button); + basic_view.AddChild (&ok_button); + basic_view.AddChild (&size_entry); + split_view.AddChild (&font_family_scroller, 0.7); + split_view.AddChild (&style_view, 0.3); + style_view.AddChild (&font_style_scroller); + style_view.AddChild (&preview_checkbox); + + basic_view.SetViewUIColor (B_PANEL_BACKGROUND_COLOR); + style_view.SetViewUIColor (B_PANEL_BACKGROUND_COLOR); + + FrameResized (801, 801); + UpdateForSelectedStyle (); + + selection = new BMessage (FONT_FAMILY_SELECTED); + font_family_pane.SetSelectionMessage (selection); + selection = new BMessage (FONT_STYLE_SELECTED); + font_style_pane.SetSelectionMessage (selection); + selection = new BMessage (B_OK); + font_style_pane.SetInvocationMessage (selection); + selection = new BMessage (UPDATE_PREVIEW_DIALOG); + size_entry.SetModificationMessage (selection); + + comm_port = create_port (1, "font dialog port"); + + n_families = count_font_families (); + + for (i = 0; i < n_families; ++i) + { + if (get_font_family (i, &name, &flags) == B_OK) + { + family_item = new BStringItem (name); + + all_families.AddItem (family_item); + font_family_pane.AddItem (family_item); + + family_item->SetEnabled (!allow_monospace_only + || flags & B_IS_FIXED); + } + else + { + family_item = new BStringItem ("<error>"); + + all_families.AddItem (family_item); + font_family_pane.AddItem (family_item); + } + } + + if (initial_family_idx >= 0) + { + font_family_pane.Select (initial_family_idx); + font_family_pane.ScrollToSelection (); + } + + size_text = size_entry.TextView (); + + for (c = 0; c <= 47; ++c) + size_text->DisallowChar (c); + + for (c = 58; c <= 127; ++c) + size_text->DisallowChar (c); + + if (initial_size > 0 && initial_size < 1000) + { + sprintf (format_buffer, "%d", initial_size); + size_entry.SetText (format_buffer); + } + } + + void + FrameResized (float new_width, float new_height) + { + BRect frame; + float ok_height, ok_width; + float cancel_height, cancel_width; + float size_width, size_height; + float bone; + int max_height; + + ok_button.GetPreferredSize (&ok_width, &ok_height); + cancel_button.GetPreferredSize (&cancel_width, + &cancel_height); + size_entry.GetPreferredSize (&size_width, &size_height); + + max_height = std::max (std::max (ok_height, cancel_height), + size_height); + + SetSizeLimits (cancel_width + ok_width + size_width + 6, + 65535, max_height + 64, 65535); + frame = Frame (); + + basic_view.ResizeTo (BE_RECT_WIDTH (frame), BE_RECT_HEIGHT (frame)); + split_view.ResizeTo (BE_RECT_WIDTH (frame) - 1, + BE_RECT_HEIGHT (frame) - 4 - max_height); + + bone = BE_RECT_HEIGHT (frame) - 2 - max_height / 2; + + ok_button.MoveTo ((BE_RECT_WIDTH (frame) + - 4 - cancel_width - ok_width), + bone - ok_height / 2); + cancel_button.MoveTo (BE_RECT_WIDTH (frame) - 2 - cancel_width, + bone - cancel_height / 2); + size_entry.MoveTo (2, bone - size_height / 2); + + ok_button.ResizeTo (ok_width, ok_height); + cancel_button.ResizeTo (cancel_width, cancel_height); + size_entry.ResizeTo (std::max (size_width, + BE_RECT_WIDTH (frame) / 4), + size_height); + } + + void + WaitForChoice (struct font_selection_dialog_message *msg, + void (*process_pending_signals_function) (void), + bool (*should_quit_function) (void)) + { + int32 reply_type; + struct object_wait_info infos[2]; + ssize_t status; + + infos[0].object = port_application_to_emacs; + infos[0].type = B_OBJECT_TYPE_PORT; + infos[0].events = B_EVENT_READ; + + infos[1].object = comm_port; + infos[1].type = B_OBJECT_TYPE_PORT; + infos[1].events = B_EVENT_READ; + + while (true) + { + status = wait_for_objects (infos, 2); + + if (status < B_OK) + continue; + + if (infos[1].events & B_EVENT_READ) + { + if (read_port (comm_port, &reply_type, + msg, sizeof *msg) >= B_OK) + return; + + goto cancel; + } + + if (infos[0].events & B_EVENT_READ) + process_pending_signals_function (); + + if (should_quit_function ()) + goto cancel; + + infos[0].events = B_EVENT_READ; + infos[1].events = B_EVENT_READ; + } + + cancel: + msg->cancel = true; + return; + } + + status_t + InitCheck (void) + { + return comm_port >= B_OK ? B_OK : comm_port; + } +}; + static int32 start_running_application (void *data) { + Emacs *app = (Emacs *) data; + haiku_io_init_in_app_thread (); - if (!((Emacs *) data)->Lock ()) + if (!app->Lock ()) gui_abort ("Failed to lock application"); - ((Emacs *) data)->Run (); - ((Emacs *) data)->Unlock (); + app->Run (); + app->Unlock (); return 0; } @@ -2346,44 +3107,58 @@ BBitmap_dimensions (void *bitmap, int *left, int *top, *mono_p = (((BBitmap *) bitmap)->ColorSpace () == B_GRAY1); } +static void +wait_for_exit_of_app_thread (void) +{ + status_t ret; + + be_app->PostMessage (QUIT_APPLICATION); + wait_for_thread (app_thread, &ret); +} + /* Set up an application and return it. If starting the application thread fails, abort Emacs. */ void * BApplication_setup (void) { - if (be_app) - return be_app; thread_id id; Emacs *app; + if (be_app) + return be_app; + app = new Emacs; app->Unlock (); + if ((id = spawn_thread (start_running_application, "Emacs app thread", B_DEFAULT_MEDIA_PRIORITY, app)) < 0) gui_abort ("spawn_thread failed"); resume_thread (id); - app_thread = id; + + atexit (wait_for_exit_of_app_thread); return app; } /* Set up and return a window with its view put in VIEW. */ void * -BWindow_new (void *_view) +BWindow_new (void **view) { - BWindow *window = new (std::nothrow) EmacsWindow; - BView **v = (BView **) _view; + BWindow *window; + BView *vw; + + window = new (std::nothrow) EmacsWindow; if (!window) { - *v = NULL; + *view = NULL; return window; } - BView *vw = new (std::nothrow) EmacsView; + vw = new (std::nothrow) EmacsView; if (!vw) { - *v = NULL; + *view = NULL; window->LockLooper (); window->Quit (); return NULL; @@ -2397,15 +3172,17 @@ BWindow_new (void *_view) the first time. */ window->UnlockLooper (); window->AddChild (vw); - *v = vw; + *view = vw; return window; } void BWindow_quit (void *window) { - ((BWindow *) window)->LockLooper (); - ((BWindow *) window)->Quit (); + BWindow *w = (BWindow *) window; + + w->LockLooper (); + w->Quit (); } /* Set WINDOW's offset to X, Y. */ @@ -2726,42 +3503,6 @@ BWindow_center_on_screen (void *window) w->CenterOnScreen (); } -/* Tell VIEW it has been clicked at X by Y. */ -void -BView_mouse_down (void *view, int x, int y) -{ - BView *vw = (BView *) view; - if (vw->LockLooper ()) - { - vw->MouseDown (BPoint (x, y)); - vw->UnlockLooper (); - } -} - -/* Tell VIEW the mouse has been released at X by Y. */ -void -BView_mouse_up (void *view, int x, int y) -{ - BView *vw = (BView *) view; - if (vw->LockLooper ()) - { - vw->MouseUp (BPoint (x, y)); - vw->UnlockLooper (); - } -} - -/* Tell VIEW that the mouse has moved to Y by Y. */ -void -BView_mouse_moved (void *view, int x, int y, uint32_t transit) -{ - BView *vw = (BView *) view; - if (vw->LockLooper ()) - { - vw->MouseMoved (BPoint (x, y), transit, NULL); - vw->UnlockLooper (); - } -} - /* Import fringe bitmap (short array, low bit rightmost) BITS into BITMAP using the B_GRAY1 colorspace. */ void @@ -2911,11 +3652,12 @@ BWindow_change_decoration (void *window, int decorate_p) void BWindow_set_tooltip_decoration (void *window) { - BWindow *w = (BWindow *) window; + EmacsWindow *w = (EmacsWindow *) window; if (!w->LockLooper ()) gui_abort ("Failed to lock window while setting ttip decoration"); + w->tooltip_p = true; + w->RecomputeFeel (); w->SetLook (B_BORDERED_WINDOW_LOOK); - w->SetFeel (kMenuWindowFeel); w->SetFlags (B_NOT_ZOOMABLE | B_NOT_MINIMIZABLE | B_AVOID_FRONT @@ -2949,20 +3691,6 @@ BView_emacs_delete (void *view) delete vw; } -/* Return the current workspace. */ -uint32_t -haiku_current_workspace (void) -{ - return current_workspace (); -} - -/* Return a bitmask consisting of workspaces WINDOW is on. */ -uint32_t -BWindow_workspaces (void *window) -{ - return ((BWindow *) window)->Workspaces (); -} - /* Create a popup menu. */ void * BPopUpMenu_new (const char *name) @@ -3477,24 +4205,35 @@ int be_get_display_planes (void) { color_space space = dpy_color_space; + BScreen screen; + if (space == B_NO_COLOR_SPACE) { - BScreen screen; /* This is actually a very slow operation. */ if (!screen.IsValid ()) gui_abort ("Invalid screen"); + space = dpy_color_space = screen.ColorSpace (); } - if (space == B_RGB32 || space == B_RGB24) - return 24; - if (space == B_RGB16) - return 16; - if (space == B_RGB15) - return 15; - if (space == B_CMAP8) - return 8; + switch (space) + { + case B_RGB32: + case B_RGB24: + return 24; + case B_RGB16: + return 16; + case B_RGB15: + return 15; + case B_CMAP8: + case B_GRAY8: + return 8; + case B_GRAY1: + return 1; + + default: + gui_abort ("Bad colorspace for screen"); + } - gui_abort ("Bad colorspace for screen"); /* https://www.haiku-os.org/docs/api/classBScreen.html says a valid screen can't be anything else. */ return -1; @@ -3504,28 +4243,58 @@ be_get_display_planes (void) int be_get_display_color_cells (void) { + BScreen screen; color_space space = dpy_color_space; + if (space == B_NO_COLOR_SPACE) { - BScreen screen; if (!screen.IsValid ()) gui_abort ("Invalid screen"); + space = dpy_color_space = screen.ColorSpace (); } - if (space == B_RGB32 || space == B_RGB24) - return 1677216; - if (space == B_RGB16) - return 65536; - if (space == B_RGB15) - return 32768; - if (space == B_CMAP8) - return 256; + switch (space) + { + case B_RGB32: + case B_RGB24: + return 16777216; + case B_RGB16: + return 65536; + case B_RGB15: + return 32768; + case B_CMAP8: + case B_GRAY8: + return 256; + case B_GRAY1: + return 2; + + default: + gui_abort ("Bad colorspace for screen"); + } - gui_abort ("Bad colorspace for screen"); return -1; } +/* Return whether or not the current display is only capable of + producing grayscale colors. */ +bool +be_is_display_grayscale (void) +{ + BScreen screen; + color_space space = dpy_color_space; + + if (space == B_NO_COLOR_SPACE) + { + if (!screen.IsValid ()) + gui_abort ("Invalid screen"); + + space = dpy_color_space = screen.ColorSpace (); + } + + return space == B_GRAY8 || space == B_GRAY1; +} + /* Warp the pointer to X by Y. */ void be_warp_pointer (int x, int y) @@ -3617,111 +4386,92 @@ EmacsView_double_buffered_p (void *vw) return db_p; } -struct popup_file_dialog_data -{ - BMessage *msg; - BFilePanel *panel; - BEntry *entry; -}; - -static void -unwind_popup_file_dialog (void *ptr) -{ - struct popup_file_dialog_data *data = - (struct popup_file_dialog_data *) ptr; - BFilePanel *panel = data->panel; - delete panel; - delete data->entry; - delete data->msg; -} - -static void -be_popup_file_dialog_safe_set_target (BFilePanel *dialog, BWindow *window) -{ - dialog->SetTarget (BMessenger (window)); -} - /* Popup a file dialog. */ char * -be_popup_file_dialog (int open_p, const char *default_dir, int must_match_p, int dir_only_p, - void *window, const char *save_text, const char *prompt, - void (*block_input_function) (void), - void (*unblock_input_function) (void), - void (*maybe_quit_function) (void)) -{ - specpdl_ref idx = c_specpdl_idx_from_cxx (); - /* setjmp/longjmp is UB with automatic objects. */ - block_input_function (); - BWindow *w = (BWindow *) window; - uint32_t mode = dir_only_p ? B_DIRECTORY_NODE : B_FILE_NODE | B_DIRECTORY_NODE; - BEntry *path = new BEntry; - BMessage *msg = new BMessage ('FPSE'); - BFilePanel *panel = new BFilePanel (open_p ? B_OPEN_PANEL : B_SAVE_PANEL, - NULL, NULL, mode); - - struct popup_file_dialog_data dat; - dat.entry = path; - dat.msg = msg; - dat.panel = panel; - - record_c_unwind_protect_from_cxx (unwind_popup_file_dialog, &dat); +be_popup_file_dialog (int open_p, const char *default_dir, int must_match_p, + int dir_only_p, void *window, const char *save_text, + const char *prompt, + void (*process_pending_signals_function) (void)) +{ + BWindow *w, *panel_window; + BEntry path; + BMessage msg (FILE_PANEL_SELECTION); + BFilePanel panel (open_p ? B_OPEN_PANEL : B_SAVE_PANEL, + NULL, NULL, (dir_only_p + ? B_DIRECTORY_NODE + : B_FILE_NODE | B_DIRECTORY_NODE)); + object_wait_info infos[2]; + ssize_t status; + int32 reply_type; + char *file_name; + + current_file_panel_port = create_port (1, "file panel port"); + file_name = NULL; + + if (current_file_panel_port < B_OK) + return NULL; + if (default_dir) { - if (path->SetTo (default_dir, 0) != B_OK) + if (path.SetTo (default_dir, 0) != B_OK) default_dir = NULL; } - panel->SetMessage (msg); + w = (BWindow *) window; + panel_window = panel.Window (); + + panel.SetMessage (&msg); + if (default_dir) - panel->SetPanelDirectory (path); + panel.SetPanelDirectory (&path); + if (save_text) - panel->SetSaveText (save_text); - panel->SetHideWhenDone (0); - panel->Window ()->SetTitle (prompt); - be_popup_file_dialog_safe_set_target (panel, w); + panel.SetSaveText (save_text); - panel->Show (); - unblock_input_function (); + panel_window->SetTitle (prompt); + panel_window->SetFeel (B_MODAL_APP_WINDOW_FEEL); + + panel.SetHideWhenDone (false); + panel.SetTarget (BMessenger (w)); + panel.Show (); + + infos[0].object = port_application_to_emacs; + infos[0].type = B_OBJECT_TYPE_PORT; + infos[0].events = B_EVENT_READ; + + infos[1].object = current_file_panel_port; + infos[1].type = B_OBJECT_TYPE_PORT; + infos[1].events = B_EVENT_READ; - void *buf = alloca (200); - while (1) + while (true) { - enum haiku_event_type type; - char *ptr = NULL; + status = wait_for_objects (infos, 2); - if (!haiku_read_with_timeout (&type, buf, 200, 1000000, false)) - { - block_input_function (); - if (type != FILE_PANEL_EVENT) - haiku_write (type, buf); - else if (!ptr) - ptr = (char *) ((struct haiku_file_panel_event *) buf)->ptr; - unblock_input_function (); + if (status == B_INTERRUPTED || status == B_WOULD_BLOCK) + continue; - maybe_quit_function (); - } + if (infos[0].events & B_EVENT_READ) + process_pending_signals_function (); - ssize_t b_s; - block_input_function (); - haiku_read_size (&b_s, false); - if (!b_s || ptr || panel->Window ()->IsHidden ()) + if (infos[1].events & B_EVENT_READ) { - c_unbind_to_nil_from_cxx (idx); - unblock_input_function (); - return ptr; + status = read_port (current_file_panel_port, + &reply_type, &file_name, + sizeof file_name); + + if (status < B_OK) + file_name = NULL; + + goto out; } - unblock_input_function (); - } -} -void -be_app_quit (void) -{ - if (be_app) - { - while (!be_app->Lock ()); - be_app->Quit (); + infos[0].events = B_EVENT_READ; + infos[1].events = B_EVENT_READ; } + + out: + delete_port (current_file_panel_port); + return file_name; } /* Zoom WINDOW. */ @@ -3748,20 +4498,18 @@ EmacsWindow_unzoom (void *window) w->UnZoom (); } -/* Move the pointer into MBAR and start tracking. */ -void +/* Move the pointer into MBAR and start tracking. Return whether the + menu bar was opened correctly. */ +bool BMenuBar_start_tracking (void *mbar) { EmacsMenuBar *mb = (EmacsMenuBar *) mbar; - if (!mb->LockLooper ()) - gui_abort ("Couldn't lock menubar"); - BRect frame = mb->Frame (); - BPoint pt = frame.LeftTop (); - BPoint l = pt; - mb->Parent ()->ConvertToScreen (&pt); - set_mouse_position (pt.x, pt.y); - mb->MouseDown (l); - mb->UnlockLooper (); + BMessenger messenger (mb); + BMessage reply; + + messenger.SendMessage (SHOW_MENU_BAR, &reply); + + return reply.what == BE_MENU_BAR_OPEN; } #ifdef HAVE_NATIVE_IMAGE_API @@ -3943,17 +4691,6 @@ be_get_display_screens (void) } /* Set the minimum width the user can resize WINDOW to. */ -void -BWindow_set_min_size (void *window, int width, int height) -{ - BWindow *w = (BWindow *) window; - - if (!w->LockLooper ()) - gui_abort ("Failed to lock window looper setting min size"); - w->SetSizeLimits (width, -1, height, -1); - w->UnlockLooper (); -} - /* Synchronize WINDOW's connection to the App Server. */ void BWindow_sync (void *window) @@ -4023,9 +4760,8 @@ BWindow_set_override_redirect (void *window, bool 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_look = w->Look (); - w->SetFeel (kMenuWindowFeel); + w->RecomputeFeel (); w->SetLook (B_NO_BORDER_WINDOW_LOOK); w->pre_override_redirect_workspaces = w->Workspaces (); w->SetWorkspaces (B_ALL_WORKSPACES); @@ -4033,8 +4769,8 @@ BWindow_set_override_redirect (void *window, bool override_redirect_p) else if (w->override_redirect_p) { w->override_redirect_p = false; - w->SetFeel (w->pre_override_redirect_feel); w->SetLook (w->pre_override_redirect_look); + w->RecomputeFeel (); w->SetWorkspaces (w->pre_override_redirect_workspaces); } @@ -4063,17 +4799,6 @@ be_find_setting (const char *name) } 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); -} - -void BMessage_delete (void *message) { delete (BMessage *) message; @@ -4189,3 +4914,108 @@ be_drag_and_drop_in_progress (void) { return drag_and_drop_in_progress; } + +/* Replay the menu bar click event EVENT. Return whether or not the + menu bar actually opened. */ +bool +be_replay_menu_bar_event (void *menu_bar, + struct haiku_menu_bar_click_event *event) +{ + BMenuBar *m = (BMenuBar *) menu_bar; + BMessenger messenger (m); + BMessage reply, msg (REPLAY_MENU_BAR); + + msg.AddPoint ("emacs:point", BPoint (event->x, event->y)); + messenger.SendMessage (&msg, &reply); + return reply.what == BE_MENU_BAR_OPEN; +} + +void +BWindow_set_z_group (void *window, enum haiku_z_group z_group) +{ + EmacsWindow *w = (EmacsWindow *) window; + + if (w->LockLooper ()) + { + if (w->z_group != z_group) + { + w->z_group = z_group; + w->RecomputeFeel (); + + if (w->z_group == Z_GROUP_BELOW) + w->SetFlags (w->Flags () | B_AVOID_FRONT); + else + w->SetFlags (w->Flags () & ~B_AVOID_FRONT); + } + + w->UnlockLooper (); + } +} + +int +be_get_ui_color (const char *name, uint32_t *color) +{ + color_which which; + rgb_color rgb; + + which = which_ui_color (name); + + if (which == B_NO_COLOR) + return 1; + + rgb = ui_color (which); + *color = (rgb.blue | rgb.green << 8 + | rgb.red << 16 | 255 << 24); + + return 0; +} + +bool +be_select_font (void (*process_pending_signals_function) (void), + bool (*should_quit_function) (void), + haiku_font_family_or_style *family, + haiku_font_family_or_style *style, + int *size, bool allow_monospace_only, + int initial_family, int initial_style, + int initial_size) +{ + EmacsFontSelectionDialog *dialog; + struct font_selection_dialog_message msg; + uint32 flags; + font_family family_buffer; + font_style style_buffer; + + dialog = new EmacsFontSelectionDialog (allow_monospace_only, + initial_family, initial_style, + initial_size); + dialog->CenterOnScreen (); + + if (dialog->InitCheck () < B_OK) + { + dialog->Quit (); + return false; + } + + dialog->Show (); + dialog->WaitForChoice (&msg, process_pending_signals_function, + should_quit_function); + + if (!dialog->LockLooper ()) + gui_abort ("Failed to lock font selection dialog looper"); + dialog->Quit (); + + if (msg.cancel) + return false; + + if (get_font_family (msg.family_idx, + &family_buffer, &flags) != B_OK + || get_font_style (family_buffer, msg.style_idx, + &style_buffer, &flags) != B_OK) + return false; + + memcpy (family, family_buffer, sizeof *family); + memcpy (style, style_buffer, sizeof *style); + *size = msg.size_specified ? msg.size : -1; + + return true; +} diff --git a/src/haiku_support.h b/src/haiku_support.h index d0a78c693b9..0fe2af3329a 100644 --- a/src/haiku_support.h +++ b/src/haiku_support.h @@ -38,21 +38,28 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ enum haiku_cursor { - CURSOR_ID_NO_CURSOR = 12, - CURSOR_ID_RESIZE_NORTH = 15, - CURSOR_ID_RESIZE_EAST = 16, - CURSOR_ID_RESIZE_SOUTH = 17, - CURSOR_ID_RESIZE_WEST = 18, - CURSOR_ID_RESIZE_NORTH_EAST = 19, - CURSOR_ID_RESIZE_NORTH_WEST = 20, - CURSOR_ID_RESIZE_SOUTH_EAST = 21, - CURSOR_ID_RESIZE_SOUTH_WEST = 22, - CURSOR_ID_RESIZE_NORTH_SOUTH = 23, - CURSOR_ID_RESIZE_EAST_WEST = 24, + CURSOR_ID_NO_CURSOR = 12, + CURSOR_ID_RESIZE_NORTH = 15, + CURSOR_ID_RESIZE_EAST = 16, + CURSOR_ID_RESIZE_SOUTH = 17, + CURSOR_ID_RESIZE_WEST = 18, + CURSOR_ID_RESIZE_NORTH_EAST = 19, + CURSOR_ID_RESIZE_NORTH_WEST = 20, + CURSOR_ID_RESIZE_SOUTH_EAST = 21, + CURSOR_ID_RESIZE_SOUTH_WEST = 22, + CURSOR_ID_RESIZE_NORTH_SOUTH = 23, + CURSOR_ID_RESIZE_EAST_WEST = 24, CURSOR_ID_RESIZE_NORTH_EAST_SOUTH_WEST = 25, CURSOR_ID_RESIZE_NORTH_WEST_SOUTH_EAST = 26 }; +enum haiku_z_group + { + Z_GROUP_ABOVE, + Z_GROUP_NONE, + Z_GROUP_BELOW, + }; + enum haiku_alert_type { HAIKU_EMPTY_ALERT = 0, @@ -80,10 +87,10 @@ enum haiku_event_type SCROLL_BAR_DRAG_EVENT, WHEEL_MOVE_EVENT, MENU_BAR_RESIZE, + MENU_BAR_CLICK, MENU_BAR_OPEN, MENU_BAR_SELECT_EVENT, MENU_BAR_CLOSE, - FILE_PANEL_EVENT, MENU_BAR_HELP_EVENT, ZOOM_EVENT, DRAG_AND_DROP_EVENT, @@ -130,10 +137,13 @@ struct haiku_dummy_event char dummy; }; -#define HAIKU_MODIFIER_ALT (1) -#define HAIKU_MODIFIER_CTRL (1 << 1) -#define HAIKU_MODIFIER_SHIFT (1 << 2) -#define HAIKU_MODIFIER_SUPER (1 << 3) +enum haiku_modifier_specification + { + HAIKU_MODIFIER_ALT = 1, + HAIKU_MODIFIER_CTRL = (1 << 1), + HAIKU_MODIFIER_SHIFT = (1 << 2), + HAIKU_MODIFIER_SUPER = (1 << 3), + }; struct haiku_key_event { @@ -168,6 +178,12 @@ struct haiku_menu_bar_left_event int x, y; }; +struct haiku_menu_bar_click_event +{ + void *window; + int x, y; +}; + struct haiku_button_event { void *window; @@ -205,11 +221,6 @@ struct haiku_menu_bar_select_event void *ptr; }; -struct haiku_file_panel_event -{ - void *ptr; -}; - struct haiku_menu_bar_help_event { void *window; @@ -221,19 +232,22 @@ struct haiku_menu_bar_help_event struct haiku_zoom_event { void *window; - bool zoomed; }; -#define FSPEC_FAMILY 1 -#define FSPEC_STYLE (1 << 1) -#define FSPEC_SLANT (1 << 2) -#define FSPEC_WEIGHT (1 << 3) -#define FSPEC_SPACING (1 << 4) -#define FSPEC_WANTED (1 << 5) -#define FSPEC_NEED_ONE_OF (1 << 6) -#define FSPEC_WIDTH (1 << 7) -#define FSPEC_LANGUAGE (1 << 8) +enum haiku_font_specification + { + FSPEC_FAMILY = 1, + FSPEC_STYLE = 1 << 1, + FSPEC_SLANT = 1 << 2, + FSPEC_WEIGHT = 1 << 3, + FSPEC_SPACING = 1 << 4, + FSPEC_WANTED = 1 << 5, + FSPEC_NEED_ONE_OF = 1 << 6, + FSPEC_WIDTH = 1 << 7, + FSPEC_LANGUAGE = 1 << 8, + FSPEC_INDICES = 1 << 9, + }; typedef char haiku_font_family_or_style[64]; @@ -267,27 +281,81 @@ enum haiku_font_language MAX_LANGUAGE /* This isn't a language. */ }; +enum haiku_font_weight + { + NO_WEIGHT = -1, + HAIKU_THIN = 0, + HAIKU_EXTRALIGHT = 40, + HAIKU_LIGHT = 50, + HAIKU_SEMI_LIGHT = 75, + HAIKU_REGULAR = 100, + HAIKU_SEMI_BOLD = 180, + HAIKU_BOLD = 200, + HAIKU_EXTRA_BOLD = 205, + HAIKU_BOOK = 400, + HAIKU_HEAVY = 800, + HAIKU_ULTRA_HEAVY = 900, + HAIKU_BLACK = 1000, + HAIKU_MEDIUM = 2000, + }; + struct haiku_font_pattern { + /* Bitmask indicating which fields are set. */ int specified; + + /* The next font in this list. */ struct haiku_font_pattern *next; - /* The next two fields are only temporarily used during the font - discovery process! Do not rely on them being correct outside - BFont_find. */ + + /* The last font in the list during font lookup. */ struct haiku_font_pattern *last; + + /* The next font in the list whose family differs from this one. + Only valid during font lookup. */ struct haiku_font_pattern *next_family; + + /* The family of the font. */ haiku_font_family_or_style family; + + /* The style of the font. */ haiku_font_family_or_style style; - int weight; + + /* Whether or the font is monospace. */ int mono_spacing_p; - int want_chars_len; - int need_one_of_len; + + /* The slant of the font. */ enum haiku_font_slant slant; + + /* The width of the font. */ enum haiku_font_width width; + + /* The language of the font. Used during font lookup. */ enum haiku_font_language language; - uint32_t *wanted_chars; - uint32_t *need_one_of; + /* The weight of the font. */ + enum haiku_font_weight weight; + + /* List of characters that must be present in the font for the match + to succeed. */ + int *wanted_chars; + + /* The number of characters in `wanted_chars'. */ + int want_chars_len; + + /* List of characters. The font must fullfill at least one of + them for the match to succeed. */ + int *need_one_of; + + /* The number of characters in `need_one_of'. */ + int need_one_of_len; + + /* The index of the family of the font this pattern represents. */ + int family_index; + + /* The index of the style of the font this pattern represents. */ + int style_index; + + /* Temporary field used during font enumeration. */ int oblique_seen_p; }; @@ -328,24 +396,12 @@ struct haiku_menu_bar_resize_event struct haiku_menu_bar_state_event { void *window; - bool no_lock; }; -#define HAIKU_THIN 0 -#define HAIKU_ULTRALIGHT 20 -#define HAIKU_EXTRALIGHT 40 -#define HAIKU_LIGHT 50 -#define HAIKU_SEMI_LIGHT 75 -#define HAIKU_REGULAR 100 -#define HAIKU_SEMI_BOLD 180 -#define HAIKU_BOLD 200 -#define HAIKU_EXTRA_BOLD 205 -#define HAIKU_ULTRA_BOLD 210 -#define HAIKU_BOOK 400 -#define HAIKU_HEAVY 800 -#define HAIKU_ULTRA_HEAVY 900 -#define HAIKU_BLACK 1000 -#define HAIKU_MEDIUM 2000 +struct haiku_session_manager_reply +{ + bool quit_reply; +}; #ifdef __cplusplus /* Haiku's built in Height and Width functions for calculating @@ -373,7 +429,6 @@ struct haiku_menu_bar_state_event to bind to the specpdl and handle quitting correctly. */ #ifdef __cplusplus - #if SIZE_MAX > 0xffffffff #define WRAP_SPECPDL_REF 1 #endif @@ -395,610 +450,254 @@ extern "C" #include <OS.h> #ifdef __cplusplus - typedef void *haiku; - - extern void - haiku_put_pixel (haiku bitmap, int x, int y, unsigned long pixel); +typedef void *haiku; - extern unsigned long - haiku_get_pixel (haiku bitmap, int x, int y); +extern void haiku_put_pixel (haiku, int, int, unsigned long); +extern unsigned long haiku_get_pixel (haiku, int, int); #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, 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, - bigtime_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, - bool popup_menu_p); - - extern void - rgb_color_hsl (uint32_t rgb, double *h, double *s, double *l); - - extern void - hsl_color_rgb (double h, double s, double l, uint32_t *rgb); - - extern void * - BBitmap_new (int width, int height, int mono_p); - - extern void * - BBitmap_data (void *bitmap); - - extern int - BBitmap_convert (void *bitmap, void **new_bitmap); - - extern void - BBitmap_free (void *bitmap); - - extern void - BBitmap_dimensions (void *bitmap, int *left, int *top, - int *right, int *bottom, int32_t *bytes_per_row, - int *mono_p); - - extern void * - BApplication_setup (void); - - extern void * - BWindow_new (void *view); - - extern void - BWindow_quit (void *window); - - extern void - BWindow_set_offset (void *window, int x, int y); - - extern void - BWindow_iconify (void *window); - - extern void - BWindow_set_visible (void *window, int visible_p); - - extern void - BFont_close (void *font); - - extern void - BFont_dat (void *font, int *px_size, int *min_width, int *max_width, - int *avg_width, int *height, int *space_width, int *ascent, - int *descent, int *underline_position, int *underline_thickness); - - extern int - BFont_have_char_p (void *font, int32_t chr); - - extern int - BFont_have_char_block (void *font, int32_t beg, int32_t end); - - extern void - BFont_char_bounds (void *font, const char *mb_str, int *advance, - int *lb, int *rb); - - extern void - BFont_nchar_bounds (void *font, const char *mb_str, int *advance, - int *lb, int *rb, int32_t n); - - extern void - BWindow_retitle (void *window, const char *title); - - extern void - BWindow_resize (void *window, int width, int height); - - extern void - BWindow_activate (void *window); - - extern void - BView_StartClip (void *view); - - extern void - BView_EndClip (void *view); - - extern void - BView_SetHighColor (void *view, uint32_t color); - - extern void - BView_SetHighColorForVisibleBell (void *view, uint32_t color); - - extern void - BView_SetLowColor (void *view, uint32_t color); - - extern void - BView_SetPenSize (void *view, int u); - - extern void - BView_SetFont (void *view, void *font); - - extern void - BView_MovePenTo (void *view, int x, int y); - - extern void - BView_DrawString (void *view, const char *chr, ptrdiff_t len); - - extern void - BView_DrawChar (void *view, char chr); - - extern void - BView_FillRectangle (void *view, int x, int y, int width, int height); - - extern void - BView_FillRectangleAbs (void *view, int x, int y, int x1, int y1); - - extern void - BView_FillTriangle (void *view, int x1, int y1, - int x2, int y2, int x3, int y3); - - extern void - BView_StrokeRectangle (void *view, int x, int y, int width, int height); - - extern void - BView_SetViewColor (void *view, uint32_t color); - - extern void - BView_ClipToRect (void *view, int x, int y, int width, int height); - - extern void - BView_ClipToInverseRect (void *view, int x, int y, int width, int height); - - extern void - BView_StrokeLine (void *view, int sx, int sy, int tx, int ty); - - extern void - BView_CopyBits (void *view, int x, int y, int width, int height, - int tox, int toy, int towidth, int toheight); - - extern void - BView_DrawBitmap (void *view, void *bitmap, int x, int y, - int width, int height, int vx, int vy, int vwidth, - int vheight); - - extern void - BView_DrawBitmapWithEraseOp (void *view, void *bitmap, int x, - int y, int width, int height); - - extern void - BView_DrawMask (void *src, void *view, - int x, int y, int width, int height, - 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); - - extern void - BScreen_px_dim (int *width, int *height); - - extern void - BView_resize_to (void *view, int width, int height); - - /* Functions for creating and freeing cursors. */ - extern void * - BCursor_create_default (void); - - extern void * - BCursor_from_id (enum haiku_cursor cursor); - - extern void * - BCursor_create_modeline (void); - - extern void * - BCursor_create_i_beam (void); - - extern void * - BCursor_create_progress_cursor (void); - - extern void * - BCursor_create_grab (void); - - extern void - BCursor_delete (void *cursor); - - extern void - BView_set_view_cursor (void *view, void *cursor); - - extern void - BWindow_Flush (void *window); - - extern void * - BScrollBar_make_for_view (void *view, int horizontal_p, - int x, int y, int x1, int y1, - void *scroll_bar_ptr); - - extern void - BScrollBar_delete (void *sb); - - extern void - BView_move_frame (void *view, int x, int y, int x1, int y1); - - extern void - BView_scroll_bar_update (void *sb, int portion, int whole, int position, - int dragging, bool can_overscroll); - - extern int - BScrollBar_default_size (int horizontal_p); - - extern void - BView_invalidate (void *view); - - extern void - BView_draw_lock (void *view, bool invalidate_region, - int x, int y, int width, int height); - - extern void - BView_invalidate_region (void *view, int x, int y, int width, int height); - - extern void - BView_draw_unlock (void *view); - - extern void - BWindow_center_on_screen (void *window); - - extern void - BView_mouse_moved (void *view, int x, int y, uint32_t transit); - - extern void - BView_mouse_down (void *view, int x, int y); - - extern void - 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 - haiku_font_pattern_free (struct haiku_font_pattern *pt); - - extern struct haiku_font_pattern * - BFont_find (struct haiku_font_pattern *pt); - - extern int - BFont_open_pattern (struct haiku_font_pattern *pat, void **font, float size); - - extern void - BFont_populate_fixed_family (struct haiku_font_pattern *ptn); - - extern void - BFont_populate_plain_family (struct haiku_font_pattern *ptn); - - extern void - BView_publish_scroll_bar (void *view, int x, int y, int width, int height); - - extern void - BView_forget_scroll_bar (void *view, int x, int y, int width, int height); - - extern bool - BView_inside_scroll_bar (void *view, int x, int y); - - extern void - BView_get_mouse (void *view, int *x, int *y); - - extern void - BView_convert_to_screen (void *view, int *x, int *y); - - extern void - BView_convert_from_screen (void *view, int *x, int *y); - - extern void - BWindow_change_decoration (void *window, int decorate_p); - - extern void - BWindow_set_tooltip_decoration (void *window); - - extern void - BWindow_set_avoid_focus (void *window, int avoid_focus_p); - - extern void - BView_emacs_delete (void *view); - - extern uint32_t - haiku_current_workspace (void); - - extern uint32_t - BWindow_workspaces (void *window); - - extern void * - BPopUpMenu_new (const char *name); - - extern void - BMenu_add_item (void *menu, const char *label, void *ptr, bool enabled_p, - bool marked_p, bool mbar_p, void *mbw_ptr, const char *key, - const char *help); - - extern void - BMenu_add_separator (void *menu); - - extern void * - BMenu_new_submenu (void *menu, const char *label, bool enabled_p); - - extern void * - BMenu_new_menu_bar_submenu (void *menu, const char *label); - - extern int - BMenu_count_items (void *menu); - - extern void * - BMenu_item_at (void *menu, int idx); - - extern void * - BMenu_run (void *menu, int x, int y, - void (*run_help_callback) (void *, void *), - void (*block_input_function) (void), - void (*unblock_input_function) (void), - struct timespec (*process_pending_signals_function) (void), - void *run_help_callback_data); - - extern void - BPopUpMenu_delete (void *menu); - - extern void * - BMenuBar_new (void *view); - - extern void - BMenu_delete_all (void *menu); - - extern void - BMenuBar_delete (void *menubar); - - extern void - BMenu_item_set_label (void *item, const char *label); - - extern void * - BMenu_item_get_menu (void *item); - - extern void - BMenu_delete_from (void *menu, int start, int count); - - extern void - haiku_ring_bell (void); - - extern void * - BAlert_new (const char *text, enum haiku_alert_type type); - - extern void * - BAlert_add_button (void *alert, const char *text); - - 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); - - extern void - BView_set_tooltip (void *view, const char *tooltip); - - extern void - BAlert_delete (void *alert); - - extern void - BScreen_res (double *rrsx, double *rrsy); - - extern void - EmacsWindow_parent_to (void *window, void *other_window); - - extern void - EmacsWindow_unparent (void *window); - - extern int - BFont_string_width (void *font, const char *utf8); - - extern void - be_get_version_string (char *version, int len); - - extern int - be_get_display_planes (void); - - extern int - be_get_display_color_cells (void); - - extern void - be_warp_pointer (int x, int y); - - extern void - EmacsWindow_move_weak_child (void *window, void *child, int xoff, int yoff); - - extern void - EmacsView_set_up_double_buffering (void *vw); - - extern void - EmacsView_disable_double_buffering (void *vw); - - extern void - EmacsView_flip_and_blit (void *vw); - - extern int - EmacsView_double_buffered_p (void *vw); - - extern char * - be_popup_file_dialog (int open_p, const char *default_dir, int must_match_p, - int dir_only_p, void *window, const char *save_text, - const char *prompt, - void (*block_input_function) (void), - void (*unblock_input_function) (void), - void (*maybe_quit_function) (void)); - - extern void - record_c_unwind_protect_from_cxx (void (*) (void *), void *); - - extern specpdl_ref c_specpdl_idx_from_cxx (void); - - extern void - c_unbind_to_nil_from_cxx (specpdl_ref idx); - - extern void - BWindow_zoom (void *window); - - extern void - EmacsWindow_make_fullscreen (void *window, int fullscreen_p); - - extern void - EmacsWindow_unzoom (void *window); +extern port_id port_application_to_emacs; +extern port_id port_popup_menu_to_emacs; +extern port_id port_emacs_to_session_manager; + +extern void haiku_io_init (void); +extern void haiku_io_init_in_app_thread (void); + +extern void haiku_read_size (ssize_t *, bool); + +extern int haiku_read (enum haiku_event_type *, void *, ssize_t); +extern int haiku_read_with_timeout (enum haiku_event_type *, void *, ssize_t, + bigtime_t, bool); +extern int haiku_write (enum haiku_event_type, void *); +extern int haiku_write_without_signal (enum haiku_event_type, void *, bool); + +extern void rgb_color_hsl (uint32_t, double *, double *, double *); +extern void hsl_color_rgb (double, double, double, uint32_t *); + +extern void *BBitmap_new (int, int, int); +extern void *BBitmap_data (void *); +extern int BBitmap_convert (void *, void **); + +extern void BBitmap_free (void *); + +extern void BBitmap_dimensions (void *, int *, int *, int *, int *, + int32_t *, int *); +extern void *BApplication_setup (void); +extern void *BWindow_new (void **); +extern void BWindow_quit (void *); + +extern void BWindow_set_offset (void *, int, int); +extern void BWindow_iconify (void *); +extern void BWindow_set_visible (void *, int); +extern void BWindow_retitle (void *, const char *); +extern void BWindow_resize (void *, int, int); +extern void BWindow_activate (void *); +extern void BWindow_center_on_screen (void *); +extern void BWindow_change_decoration (void *, int); +extern void BWindow_set_tooltip_decoration (void *); +extern void BWindow_set_avoid_focus (void *, int); +extern void BWindow_zoom (void *); +extern void BWindow_set_size_alignment (void *, int, int); +extern void BWindow_sync (void *); +extern void BWindow_send_behind (void *, void *); +extern bool BWindow_is_active (void *); +extern void BWindow_set_override_redirect (void *, bool); +extern void BWindow_dimensions (void *, int *, int *); +extern void BWindow_set_z_group (void *, enum haiku_z_group); +extern void BWindow_Flush (void *); + +extern void BFont_close (void *); +extern void BFont_metrics (void *, int *, int *, int *, int *, + int *, int *, int *, int *, int *, int *); +extern int BFont_have_char_p (void *, int32_t); +extern int BFont_have_char_block (void *, int32_t, int32_t); +extern void BFont_char_bounds (void *, const char *, int *, int *, int *); +extern void BFont_nchar_bounds (void *, const char *, int *, int *, + int *, int32_t); +extern struct haiku_font_pattern *BFont_find (struct haiku_font_pattern *); + +extern void BView_StartClip (void *); +extern void BView_EndClip (void *); +extern void BView_SetHighColor (void *, uint32_t); +extern void BView_SetLowColor (void *, uint32_t); +extern void BView_SetPenSize (void *, int); +extern void BView_SetFont (void *, void *); +extern void BView_MovePenTo (void *, int, int); +extern void BView_DrawString (void *, const char *, ptrdiff_t); +extern void BView_DrawChar (void *, char); +extern void BView_FillRectangle (void *, int, int, int, int); +extern void BView_FillRectangleAbs (void *, int, int, int, int); +extern void BView_FillTriangle (void *, int, int, int, int, int, int); +extern void BView_StrokeRectangle (void *, int, int, int, int); +extern void BView_SetViewColor (void *, uint32_t); +extern void BView_ClipToRect (void *, int, int, int, int); +extern void BView_ClipToInverseRect (void *, int, int, int, int); +extern void BView_StrokeLine (void *, int, int, int, int); +extern void BView_CopyBits (void *, int, int, int, int, int, int, int, int); +extern void BView_InvertRect (void *, int, int, int, int); +extern void BView_DrawBitmap (void *, void *, int, int, int, int, int, int, + int, int); +extern void BView_DrawBitmapWithEraseOp (void *, void *, int, int, int, int); +extern void BView_DrawMask (void *, void *, int, int, int, int, int, int, + int, int, uint32_t); + +extern void BView_resize_to (void *, int, int); +extern void BView_set_view_cursor (void *, void *); +extern void BView_move_frame (void *, int, int, int, int); +extern void BView_scroll_bar_update (void *, int, int, int, int, bool); + +extern void *BBitmap_transform_bitmap (void *, void *, uint32_t, double, + int, int); + +extern void BScreen_px_dim (int *, int *); +extern void BScreen_res (double *, double *); + +/* Functions for creating and freeing cursors. */ +extern void *BCursor_create_default (void); +extern void *BCursor_from_id (enum haiku_cursor); +extern void *BCursor_create_modeline (void); +extern void *BCursor_create_i_beam (void); +extern void *BCursor_create_progress_cursor (void); +extern void *BCursor_create_grab (void); +extern void BCursor_delete (void *); + +extern void *BScrollBar_make_for_view (void *, int, int, int, int, int, void *); +extern void BScrollBar_delete (void *); +extern int BScrollBar_default_size (int); + +extern void BView_invalidate (void *); +extern void BView_draw_lock (void *, bool, int, int, int, int); +extern void BView_invalidate_region (void *, int, int, int, int); +extern void BView_draw_unlock (void *); + +extern void BBitmap_import_fringe_bitmap (void *, unsigned short *, int, int); +extern void BBitmap_import_mono_bits (void *, void *, int, int); + +extern void haiku_font_pattern_free (struct haiku_font_pattern *); + +extern int BFont_open_pattern (struct haiku_font_pattern *, void **, float); +extern void BFont_populate_fixed_family (struct haiku_font_pattern *); +extern void BFont_populate_plain_family (struct haiku_font_pattern *); + +extern void BView_publish_scroll_bar (void *, int, int, int, int); +extern void BView_forget_scroll_bar (void *, int, int, int, int); +extern bool BView_inside_scroll_bar (void *, int, int); +extern void BView_get_mouse (void *, int *, int *); +extern void BView_convert_to_screen (void *, int *, int *); +extern void BView_convert_from_screen (void *, int *, int *); + +extern void BView_emacs_delete (void *); + +extern void *BPopUpMenu_new (const char *); + +extern void BMenu_add_item (void *, const char *, void *, bool, + bool, bool, void *, const char *, + const char *); +extern void BMenu_add_separator (void *); +extern void *BMenu_new_submenu (void *, const char *, bool); +extern void *BMenu_new_menu_bar_submenu (void *, const char *); +extern int BMenu_count_items (void *); +extern void *BMenu_item_at (void *, int); +extern void *BMenu_run (void *, int, int, void (*) (void *, void *), + void (*) (void), void (*) (void), + struct timespec (*) (void), void *); +extern void BPopUpMenu_delete (void *); +extern void *BMenuBar_new (void *); +extern void BMenu_delete_all (void *); +extern void BMenuBar_delete (void *); +extern void BMenu_item_set_label (void *, const char *); +extern void *BMenu_item_get_menu (void *); +extern void BMenu_delete_from (void *, int, int); + +extern void haiku_ring_bell (void); + +extern void *BAlert_new (const char *, enum haiku_alert_type); +extern void *BAlert_add_button (void *, const char *); +extern void BAlert_set_offset_spacing (void *); +extern int32 BAlert_go (void *, void (*) (void), void (*) (void), + void (*) (void)); +extern void BButton_set_enabled (void *, int); +extern void BView_set_tooltip (void *, const char *); +extern void BView_show_tooltip (void *); +extern void BView_set_and_show_sticky_tooltip (void *, const char *, + int, int); + +extern void BAlert_delete (void *); + +extern void EmacsWindow_parent_to (void *, void *); +extern void EmacsWindow_unparent (void *); +extern void EmacsWindow_move_weak_child (void *, void *, int, int); +extern void EmacsWindow_make_fullscreen (void *, int); +extern void EmacsWindow_unzoom (void *); + +extern void be_get_version_string (char *, int); +extern int be_get_display_planes (void); +extern int be_get_display_color_cells (void); +extern bool be_is_display_grayscale (void); +extern void be_warp_pointer (int, int); + +extern void EmacsView_set_up_double_buffering (void *); +extern void EmacsView_disable_double_buffering (void *); +extern void EmacsView_flip_and_blit (void *); +extern int EmacsView_double_buffered_p (void *); + +extern char *be_popup_file_dialog (int, const char *, int, + int, void *, const char *, + const char *, void (*) (void)); #ifdef HAVE_NATIVE_IMAGE_API - extern int - be_can_translate_type_to_bitmap_p (const char *mime); - - extern void * - be_translate_bitmap_from_file_name (const char *filename); - - extern void * - be_translate_bitmap_from_memory (const void *buf, size_t bytes); +extern int be_can_translate_type_to_bitmap_p (const char *); +extern void *be_translate_bitmap_from_file_name (const char *); +extern void *be_translate_bitmap_from_memory (const void *, size_t); #endif - extern void - BMenuBar_start_tracking (void *mbar); - - extern size_t - BBitmap_bytes_length (void *bitmap); - - extern void - BView_show_tooltip (void *view); +extern bool BMenuBar_start_tracking (void *); +extern size_t BBitmap_bytes_length (void *); #ifdef USE_BE_CAIRO - extern cairo_t * - EmacsView_cairo_context (void *view); - - extern void - BView_cr_dump_clipping (void *view, cairo_t *ctx); - - extern void - EmacsWindow_begin_cr_critical_section (void *window); - - extern void - EmacsWindow_end_cr_critical_section (void *window); +extern cairo_t *EmacsView_cairo_context (void *); +extern void BView_cr_dump_clipping (void *, cairo_t *); +extern void EmacsWindow_begin_cr_critical_section (void *); +extern void EmacsWindow_end_cr_critical_section (void *); #endif - extern void - BView_set_and_show_sticky_tooltip (void *view, const char *tooltip, - int x, int y); - - extern void - BMenu_add_title (void *menu, const char *text); - - extern int - be_plain_font_height (void); - - extern int - be_string_width_with_plain_font (const char *str); - - extern int - be_get_display_screens (void); - - extern void - BWindow_set_min_size (void *window, int width, int height); - - extern void - BWindow_set_size_alignment (void *window, int align_width, int align_height); - - extern void - BWindow_sync (void *window); - - extern void - BWindow_send_behind (void *window, void *other_window); - - extern bool - BWindow_is_active (void *window); - - extern bool - be_use_subpixel_antialiasing (void); - - extern void - BWindow_set_override_redirect (void *window, bool override_redirect_p); - - 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); - - extern void - BWindow_dimensions (void *window, int *width, int *height); - - extern void - BMessage_delete (void *message); - - extern bool - be_drag_message (void *view, void *message, bool allow_same_view, - void (*block_input_function) (void), - void (*unblock_input_function) (void), - void (*process_pending_signals_function) (void), - bool (*should_quit_function) (void)); - - extern bool - be_drag_and_drop_in_progress (void); - +extern void BMenu_add_title (void *, const char *); + +extern int be_plain_font_height (void); +extern int be_string_width_with_plain_font (const char *); +extern void be_init_font_data (void); +extern void be_evict_font_cache (void); +extern int be_get_display_screens (void); +extern bool be_use_subpixel_antialiasing (void); +extern const char *be_find_setting (const char *); +extern haiku_font_family_or_style *be_list_font_families (size_t *); +extern void be_font_style_to_flags (char *, struct haiku_font_pattern *); +extern void *be_open_font_at_index (int, int, float); +extern int be_get_ui_color (const char *, uint32_t *); + +extern void BMessage_delete (void *); + +extern bool be_drag_message (void *, void *, bool, void (*) (void), + void (*) (void), void (*) (void), + bool (*) (void)); +extern bool be_drag_and_drop_in_progress (void); + +extern bool be_replay_menu_bar_event (void *, struct haiku_menu_bar_click_event *); +extern bool be_select_font (void (*) (void), bool (*) (void), + haiku_font_family_or_style *, + haiku_font_family_or_style *, + int *, bool, int, int, int); + +extern int be_find_font_indices (struct haiku_font_pattern *, int *, int *); #ifdef __cplusplus - extern void * - find_appropriate_view_for_draw (void *vw); } -extern _Noreturn void -gui_abort (const char *msg); +extern _Noreturn void gui_abort (const char *); +extern void *find_appropriate_view_for_draw (void *); #endif /* _cplusplus */ -/* Borrowed from X.Org keysymdef.h */ -#define XK_BackSpace 0xff08 /* Back space, back char */ -#define XK_Tab 0xff09 -#define XK_Linefeed 0xff0a /* Linefeed, LF */ -#define XK_Clear 0xff0b -#define XK_Return 0xff0d /* Return, enter */ -#define XK_Pause 0xff13 /* Pause, hold */ -#define XK_Scroll_Lock 0xff14 -#define XK_Sys_Req 0xff15 -#define XK_Escape 0xff1b -#define XK_Delete 0xffff /* Delete, rubout */ -#define XK_Home 0xff50 -#define XK_Left 0xff51 /* Move left, left arrow */ -#define XK_Up 0xff52 /* Move up, up arrow */ -#define XK_Right 0xff53 /* Move right, right arrow */ -#define XK_Down 0xff54 /* Move down, down arrow */ -#define XK_Prior 0xff55 /* Prior, previous */ -#define XK_Page_Up 0xff55 -#define XK_Next 0xff56 /* Next */ -#define XK_Page_Down 0xff56 -#define XK_End 0xff57 /* EOL */ -#define XK_Begin 0xff58 /* BOL */ -#define XK_Select 0xff60 /* Select, mark */ -#define XK_Print 0xff61 -#define XK_Execute 0xff62 /* Execute, run, do */ -#define XK_Insert 0xff63 /* Insert, insert here */ -#define XK_Undo 0xff65 -#define XK_Redo 0xff66 /* Redo, again */ -#define XK_Menu 0xff67 -#define XK_Find 0xff68 /* Find, search */ -#define XK_Cancel 0xff69 /* Cancel, stop, abort, exit */ -#define XK_Help 0xff6a /* Help */ -#define XK_Break 0xff6b -#define XK_Mode_switch 0xff7e /* Character set switch */ -#define XK_script_switch 0xff7e /* Alias for mode_switch */ -#define XK_Num_Lock 0xff7f -#define XK_F1 0xffbe - #endif /* _HAIKU_SUPPORT_H_ */ + +// Local Variables: +// eval: (setf (alist-get 'inextern-lang c-offsets-alist) 0) +// End: diff --git a/src/haikufns.c b/src/haikufns.c index ef95d42f0f1..e88ded23ffe 100644 --- a/src/haikufns.c +++ b/src/haikufns.c @@ -64,11 +64,10 @@ static Lisp_Object tip_last_frame; /* PARMS argument of last `x-show-tip' call. */ static Lisp_Object tip_last_parms; -static void -haiku_explicitly_set_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval); -static void -haiku_set_title (struct frame *f, Lisp_Object name, Lisp_Object old_name); +static void haiku_explicitly_set_name (struct frame *, Lisp_Object, Lisp_Object); +static void haiku_set_title (struct frame *, Lisp_Object, Lisp_Object); +/* The number of references to an image cache. */ static ptrdiff_t image_cache_refcount; static Lisp_Object @@ -255,7 +254,11 @@ int haiku_get_color (const char *name, Emacs_Color *color) { unsigned short r16, g16, b16; - Lisp_Object tem; + Lisp_Object tem, col; + int32 clr, rc; + uint32_t ui_color; + ptrdiff_t size, i; + Lisp_Object string; if (parse_color_spec (name, &r16, &g16, &b16)) { @@ -272,10 +275,11 @@ haiku_get_color (const char *name, Emacs_Color *color) tem = x_display_list->color_map; for (; CONSP (tem); tem = XCDR (tem)) { - Lisp_Object col = XCAR (tem); + col = XCAR (tem); + if (CONSP (col) && !xstrcasecmp (SSDATA (XCAR (col)), name)) { - int32_t clr = XFIXNUM (XCDR (col)); + clr = XFIXNUM (XCDR (col)); color->pixel = clr; color->red = RED_FROM_ULONG (clr) * 257; color->green = GREEN_FROM_ULONG (clr) * 257; @@ -284,11 +288,34 @@ haiku_get_color (const char *name, Emacs_Color *color) return 0; } } - unblock_input (); } - return 1; + rc = 1; + if (VECTORP (Vhaiku_allowed_ui_colors)) + { + size = ASIZE (Vhaiku_allowed_ui_colors); + + for (i = 0; i < size; ++i) + { + string = AREF (Vhaiku_allowed_ui_colors, i); + + block_input (); + if (STRINGP (string) && !strcmp (SSDATA (string), name)) + rc = be_get_ui_color (name, &ui_color); + unblock_input (); + } + } + + if (!rc) + { + color->pixel = ui_color; + color->red = RED_FROM_ULONG (ui_color) * 257; + color->green = GREEN_FROM_ULONG (ui_color) * 257; + color->blue = BLUE_FROM_ULONG (ui_color) * 257; + } + + return rc; } static struct haiku_display_info * @@ -301,10 +328,10 @@ haiku_display_info_for_name (Lisp_Object name) if (!x_display_list) return x_display_list; - error ("Be windowing not initialized"); + error ("Haiku windowing not initialized"); } - error ("Be displays can only be named \"be\""); + error ("Haiku displays can only be named \"be\""); } static struct haiku_display_info * @@ -321,14 +348,14 @@ check_haiku_display_info (Lisp_Object object) else if (x_display_list) dpyinfo = x_display_list; else - error ("Be windowing not present"); + error ("Haiku windowing not present"); } else if (TERMINALP (object)) { struct terminal *t = decode_live_terminal (object); if (t->type != output_haiku) - error ("Terminal %d is not a Be display", t->id); + error ("Terminal %d is not a Haiku display", t->id); dpyinfo = t->display_info.haiku; } @@ -396,8 +423,8 @@ haiku_set_child_frame_border_width (struct frame *f, } static void -haiku_set_parent_frame (struct frame *f, - Lisp_Object new_value, Lisp_Object old_value) +haiku_set_parent_frame (struct frame *f, Lisp_Object new_value, + Lisp_Object old_value) { struct frame *p = NULL; block_input (); @@ -422,6 +449,7 @@ haiku_set_parent_frame (struct frame *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), @@ -438,6 +466,43 @@ haiku_set_parent_frame (struct frame *f, } static void +haiku_set_z_group (struct frame *f, Lisp_Object new_value, + Lisp_Object old_value) +{ + int rc; + + /* Tooltip frames can't have Z groups, since the window feel is + overridden during frame creation. */ + if (FRAME_TOOLTIP_P (f)) + return; + + rc = 1; + block_input (); + + if (NILP (new_value)) + { + BWindow_set_z_group (FRAME_HAIKU_WINDOW (f), Z_GROUP_NONE); + FRAME_Z_GROUP (f) = z_group_none; + } + else if (EQ (new_value, Qabove)) + { + BWindow_set_z_group (FRAME_HAIKU_WINDOW (f), Z_GROUP_ABOVE); + FRAME_Z_GROUP (f) = z_group_above; + } + else if (EQ (new_value, Qbelow)) + { + BWindow_set_z_group (FRAME_HAIKU_WINDOW (f), Z_GROUP_BELOW); + FRAME_Z_GROUP (f) = z_group_below; + } + else + rc = 0; + + unblock_input (); + if (!rc) + error ("Invalid z-group specification"); +} + +static void haiku_explicitly_set_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval) { haiku_set_name (f, arg, 1); @@ -446,15 +511,13 @@ haiku_explicitly_set_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval) static void haiku_set_no_accept_focus (struct frame *f, Lisp_Object new_value, Lisp_Object old_value) { - block_input (); if (!EQ (new_value, old_value)) FRAME_NO_ACCEPT_FOCUS (f) = !NILP (new_value); + block_input (); if (FRAME_HAIKU_WINDOW (f)) - { - BWindow_set_avoid_focus (FRAME_HAIKU_WINDOW (f), - FRAME_NO_ACCEPT_FOCUS (f)); - } + BWindow_set_avoid_focus (FRAME_HAIKU_WINDOW (f), + FRAME_NO_ACCEPT_FOCUS (f)); unblock_input (); } @@ -554,14 +617,6 @@ haiku_set_foreground_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval } } -static void -unwind_popup (void) -{ - if (!popup_activated_p) - emacs_abort (); - --popup_activated_p; -} - static Lisp_Object haiku_create_frame (Lisp_Object parms) { @@ -636,6 +691,8 @@ haiku_create_frame (Lisp_Object parms) f->output_method = output_haiku; f->output_data.haiku = xzalloc (sizeof *f->output_data.haiku); + f->output_data.haiku->wait_for_event_type = -1; + f->output_data.haiku->relief_background = -1; fset_icon_name (f, gui_display_get_arg (dpyinfo, parms, Qicon_name, "iconName", "Title", @@ -648,9 +705,6 @@ haiku_create_frame (Lisp_Object parms) /* With FRAME_DISPLAY_INFO set up, this unwind-protect is safe. */ record_unwind_protect (unwind_create_frame, frame); - FRAME_OUTPUT_DATA (f)->parent_desc = NULL; - FRAME_OUTPUT_DATA (f)->explicit_parent = 0; - /* Set the name; the functions to which we pass f expect the name to be set. */ if (EQ (name, Qunbound) || NILP (name) || ! STRINGP (name)) @@ -689,7 +743,7 @@ haiku_create_frame (Lisp_Object parms) gui_default_parameter (f, parms, Qborder_width, make_fixnum (0), "borderwidth", "BorderWidth", RES_TYPE_NUMBER); - gui_default_parameter (f, parms, Qinternal_border_width, make_fixnum (2), + gui_default_parameter (f, parms, Qinternal_border_width, make_fixnum (0), "internalBorderWidth", "InternalBorderWidth", RES_TYPE_NUMBER); gui_default_parameter (f, parms, Qchild_frame_border_width, Qnil, @@ -729,11 +783,11 @@ haiku_create_frame (Lisp_Object parms) RES_TYPE_NUMBER); if (FIXNUMP (tem)) store_frame_param (f, Qmin_height, tem); + adjust_frame_size (f, FRAME_COLS (f) * FRAME_COLUMN_WIDTH (f), FRAME_LINES (f) * FRAME_LINE_HEIGHT (f), 5, 1, Qx_create_frame_1); - gui_default_parameter (f, parms, Qz_group, Qnil, NULL, NULL, RES_TYPE_SYMBOL); gui_default_parameter (f, parms, Qno_focus_on_map, Qnil, NULL, NULL, RES_TYPE_BOOLEAN); gui_default_parameter (f, parms, Qno_accept_focus, Qnil, @@ -803,8 +857,6 @@ haiku_create_frame (Lisp_Object parms) initialize_frame_menubar (f); unblock_input (); - FRAME_OUTPUT_DATA (f)->window_desc = FRAME_OUTPUT_DATA (f)->window; - Vframe_list = Fcons (frame, Vframe_list); Lisp_Object parent_frame = gui_display_get_arg (dpyinfo, parms, Qparent_frame, NULL, NULL, @@ -860,22 +912,19 @@ haiku_create_frame (Lisp_Object parms) adjust_frame_size (f, FRAME_TEXT_WIDTH (f), FRAME_TEXT_HEIGHT (f), 0, true, Qx_create_frame_2); - if (!FRAME_OUTPUT_DATA (f)->explicit_parent) - { - Lisp_Object visibility; + Lisp_Object visibility; - visibility = gui_display_get_arg (dpyinfo, parms, Qvisibility, 0, 0, - RES_TYPE_SYMBOL); - if (EQ (visibility, Qunbound)) - visibility = Qt; - if (EQ (visibility, Qicon)) - haiku_iconify_frame (f); - else if (!NILP (visibility)) - haiku_visualize_frame (f); - else /* Qnil */ - { - f->was_invisible = true; - } + visibility = gui_display_get_arg (dpyinfo, parms, Qvisibility, 0, 0, + RES_TYPE_SYMBOL); + if (EQ (visibility, Qunbound)) + visibility = Qt; + if (EQ (visibility, Qicon)) + haiku_iconify_frame (f); + else if (!NILP (visibility)) + haiku_visualize_frame (f); + else /* Qnil */ + { + f->was_invisible = true; } if (FRAME_HAS_MINIBUF_P (f) @@ -883,6 +932,9 @@ haiku_create_frame (Lisp_Object parms) || !FRAME_LIVE_P (XFRAME (KVAR (kb, Vdefault_minibuffer_frame))))) kset_default_minibuffer_frame (kb, frame); + gui_default_parameter (f, parms, Qz_group, Qnil, + NULL, NULL, RES_TYPE_SYMBOL); + for (tem = parms; CONSP (tem); tem = XCDR (tem)) if (CONSP (XCAR (tem)) && !NILP (XCAR (XCAR (tem)))) fset_param_alist (f, Fcons (XCAR (tem), f->param_alist)); @@ -955,13 +1007,14 @@ haiku_create_tip_frame (Lisp_Object parms) counts etc. */ f->output_method = output_haiku; f->output_data.haiku = xzalloc (sizeof *f->output_data.haiku); + f->output_data.haiku->wait_for_event_type = -1; + f->output_data.haiku->relief_background = -1; f->tooltip = true; fset_icon_name (f, Qnil); FRAME_DISPLAY_INFO (f) = dpyinfo; FRAME_OUTPUT_DATA (f)->parent_desc = NULL; - FRAME_OUTPUT_DATA (f)->explicit_parent = 0; /* Set the name; the functions to which we pass f expect the name to be set. */ @@ -1053,7 +1106,6 @@ haiku_create_tip_frame (Lisp_Object parms) if (!window) emacs_abort (); - FRAME_OUTPUT_DATA (f)->window_desc = window; BWindow_set_tooltip_decoration (window); unblock_input (); } @@ -1275,9 +1327,11 @@ haiku_set_override_redirect (struct frame *f, Lisp_Object new_value, static void haiku_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) { + int nlines; + if (FRAME_TOOLTIP_P (f)) return; - int nlines; + if (TYPE_RANGED_FIXNUMP (int, value)) nlines = XFIXNUM (value); else @@ -1285,9 +1339,6 @@ haiku_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval fset_redisplay (f); - FRAME_MENU_BAR_LINES (f) = 0; - FRAME_MENU_BAR_HEIGHT (f) = 0; - if (nlines) { FRAME_EXTERNAL_MENU_BAR (f) = 1; @@ -1296,11 +1347,14 @@ haiku_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval } else { + FRAME_MENU_BAR_LINES (f) = 0; + FRAME_MENU_BAR_HEIGHT (f) = 0; + if (FRAME_EXTERNAL_MENU_BAR (f)) free_frame_menubar (f); + FRAME_EXTERNAL_MENU_BAR (f) = 0; - if (FRAME_HAIKU_P (f)) - FRAME_HAIKU_MENU_BAR (f) = 0; + FRAME_HAIKU_MENU_BAR (f) = 0; } adjust_frame_glyphs (f); @@ -1360,11 +1414,12 @@ frame_geometry (Lisp_Object frame, Lisp_Object attribute) void haiku_set_background_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) { + Emacs_Color color; + struct face *defface; + CHECK_STRING (arg); block_input (); - Emacs_Color color; - if (haiku_get_color (SSDATA (arg), &color)) { store_frame_param (f, Qbackground_color, oldval); @@ -1377,8 +1432,6 @@ haiku_set_background_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval if (FRAME_HAIKU_VIEW (f)) { - struct face *defface; - BView_draw_lock (FRAME_HAIKU_VIEW (f), false, 0, 0, 0, 0); BView_SetViewColor (FRAME_HAIKU_VIEW (f), color.pixel); BView_draw_unlock (FRAME_HAIKU_VIEW (f)); @@ -1400,10 +1453,10 @@ haiku_set_background_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval void haiku_set_cursor_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) { - CHECK_STRING (arg); + Emacs_Color color, fore_pixel; + CHECK_STRING (arg); block_input (); - Emacs_Color color, fore_pixel; if (haiku_get_color (SSDATA (arg), &color)) { @@ -1444,11 +1497,7 @@ haiku_get_pixel (haiku bitmap, int x, int y) { unsigned char *data; int32_t bytes_per_row; - int mono_p; - int left; - int right; - int top; - int bottom; + int mono_p, left, right, top, bottom, byte; data = BBitmap_data (bitmap); BBitmap_dimensions (bitmap, &left, &top, &right, &bottom, @@ -1460,20 +1509,17 @@ haiku_get_pixel (haiku bitmap, int x, int y) if (!mono_p) return ((uint32_t *) (data + (bytes_per_row * y)))[x]; - int byte = y * bytes_per_row + x / 8; + byte = y * bytes_per_row + x / 8; return data[byte] & (1 << (x % 8)); } void haiku_put_pixel (haiku bitmap, int x, int y, unsigned long pixel) { - unsigned char *data; + unsigned char *data, *byte; int32_t bytes_per_row; - int mono_p; - int left; - int right; - int top; - int bottom; + int mono_p, left, right, top, bottom; + ptrdiff_t off, bit, xoff; data = BBitmap_data (bitmap); BBitmap_dimensions (bitmap, &left, &top, &right, &bottom, @@ -1484,11 +1530,11 @@ haiku_put_pixel (haiku bitmap, int x, int y, unsigned long pixel) if (mono_p) { - ptrdiff_t off = y * bytes_per_row; - ptrdiff_t bit = x % 8; - ptrdiff_t xoff = x / 8; + off = y * bytes_per_row; + bit = x % 8; + xoff = x / 8; - unsigned char *byte = data + off + xoff; + byte = data + off + xoff; if (!pixel) *byte &= ~(1 << bit); else @@ -1555,6 +1601,9 @@ haiku_free_frame_resources (struct frame *f) if (window) BWindow_quit (window); + if (FRAME_OUTPUT_DATA (f)->saved_menu_event) + xfree (FRAME_OUTPUT_DATA (f)->saved_menu_event); + xfree (FRAME_OUTPUT_DATA (f)); FRAME_OUTPUT_DATA (f) = NULL; @@ -1567,13 +1616,11 @@ haiku_iconify_frame (struct frame *frame) if (FRAME_ICONIFIED_P (frame)) return; - block_input (); - SET_FRAME_VISIBLE (frame, false); SET_FRAME_ICONIFIED (frame, true); + block_input (); BWindow_iconify (FRAME_HAIKU_WINDOW (frame)); - unblock_input (); } @@ -1615,7 +1662,8 @@ haiku_unvisualize_frame (struct frame *f) } void -haiku_set_internal_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +haiku_set_internal_border_width (struct frame *f, Lisp_Object arg, + Lisp_Object oldval) { int old_width = FRAME_INTERNAL_BORDER_WIDTH (f); int new_width = check_int_nonnegative (arg); @@ -1670,28 +1718,33 @@ check_x_display_info (Lisp_Object object) return check_haiku_display_info (object); } -/* Rename frame F to NAME. If NAME is nil, set F's name to "GNU - Emacs". If EXPLICIT_P is non-zero, that indicates Lisp code is - setting the name, not redisplay; in that case, set F's name to NAME - and set F->explicit_name; if NAME is nil, clear F->explicit_name. +/* Rename frame F to NAME. If NAME is nil, set F's name to the + default name. If EXPLICIT_P is non-zero, that indicates Lisp code + is setting the name, not redisplay; in that case, set F's name to + NAME and set F->explicit_name; if NAME is nil, clear + F->explicit_name. If EXPLICIT_P is zero, it means redisplay is setting the name; the name provided will be ignored if explicit_name is set. */ void haiku_set_name (struct frame *f, Lisp_Object name, bool explicit_p) { + struct haiku_display_info *dpyinfo; + if (explicit_p) { if (f->explicit_name && NILP (name)) - update_mode_lines = 24; + update_mode_lines = 37; f->explicit_name = !NILP (name); } else if (f->explicit_name) return; + dpyinfo = FRAME_DISPLAY_INFO (f); + if (NILP (name)) - name = build_unibyte_string ("GNU Emacs"); + name = dpyinfo->default_name; if (!NILP (Fstring_equal (name, f->name))) return; @@ -1714,19 +1767,14 @@ haiku_set_inhibit_double_buffering (struct frame *f, { #ifndef USE_BE_CAIRO if (NILP (new_value)) - { #endif - EmacsView_set_up_double_buffering (FRAME_HAIKU_VIEW (f)); - if (!NILP (old_value)) - { - SET_FRAME_GARBAGED (f); - expose_frame (f, 0, 0, 0, 0); - } + EmacsView_set_up_double_buffering (FRAME_HAIKU_VIEW (f)); #ifndef USE_BE_CAIRO - } else EmacsView_disable_double_buffering (FRAME_HAIKU_VIEW (f)); #endif + + SET_FRAME_GARBAGED (f); } unblock_input (); } @@ -1761,19 +1809,15 @@ the mouse cursor position in pixels relative to a position (0, 0) of the selected frame's display. */) (void) { - if (!x_display_list) - return Qnil; - struct frame *f = SELECTED_FRAME (); + void *view; + int x, y; - if (FRAME_INITIAL_P (f) || !FRAME_HAIKU_P (f) - || !FRAME_HAIKU_VIEW (f)) + if (FRAME_INITIAL_P (f) || !FRAME_HAIKU_P (f)) return Qnil; block_input (); - void *view = FRAME_HAIKU_VIEW (f); - - int x, y; + view = FRAME_HAIKU_VIEW (f); BView_get_mouse (view, &x, &y); BView_convert_to_screen (view, &x, &y); unblock_input (); @@ -1785,7 +1829,9 @@ DEFUN ("xw-display-color-p", Fxw_display_color_p, Sxw_display_color_p, 0, 1, 0, doc: /* SKIP: real doc in xfns.c. */) (Lisp_Object terminal) { - return Qt; + check_haiku_display_info (terminal); + + return be_is_display_grayscale () ? Qnil : Qt; } DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0, @@ -1793,6 +1839,7 @@ DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0, (Lisp_Object color, Lisp_Object frame) { Emacs_Color col; + CHECK_STRING (color); decode_window_system_frame (frame); @@ -1804,17 +1851,19 @@ DEFUN ("xw-color-values", Fxw_color_values, Sxw_color_values, 1, 2, 0, (Lisp_Object color, Lisp_Object frame) { Emacs_Color col; + int rc; + CHECK_STRING (color); decode_window_system_frame (frame); block_input (); - if (haiku_get_color (SSDATA (color), &col)) - { - unblock_input (); - return Qnil; - } + rc = haiku_get_color (SSDATA (color), &col); unblock_input (); - return list3i (lrint (col.red), lrint (col.green), lrint (col.blue)); + + if (rc) + return Qnil; + + return list3i (col.red, col.green, col.blue); } DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p, Sx_display_grayscale_p, @@ -1822,7 +1871,9 @@ DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p, Sx_display_grayscale_p, doc: /* SKIP: real doc in xfns.c. */) (Lisp_Object terminal) { - return Qnil; + check_haiku_display_info (terminal); + + return be_is_display_grayscale () ? Qt : Qnil; } DEFUN ("x-open-connection", Fx_open_connection, Sx_open_connection, @@ -1863,9 +1914,9 @@ DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width, (Lisp_Object terminal) { + int width, height; check_haiku_display_info (terminal); - int width, height; BScreen_px_dim (&width, &height); return make_fixnum (width); } @@ -1876,9 +1927,9 @@ DEFUN ("x-display-pixel-height", Fx_display_pixel_height, Sx_display_pixel_heigh (Lisp_Object terminal) { + int width, height; check_haiku_display_info (terminal); - int width, height; BScreen_px_dim (&width, &height); return make_fixnum (width); } @@ -1888,10 +1939,9 @@ DEFUN ("x-display-mm-height", Fx_display_mm_height, Sx_display_mm_height, 0, 1, (Lisp_Object terminal) { struct haiku_display_info *dpyinfo = check_haiku_display_info (terminal); - int width, height; - BScreen_px_dim (&width, &height); + BScreen_px_dim (&width, &height); return make_fixnum (height / (dpyinfo->resy / 25.4)); } @@ -1901,10 +1951,9 @@ DEFUN ("x-display-mm-width", Fx_display_mm_width, Sx_display_mm_width, 0, 1, 0, (Lisp_Object terminal) { struct haiku_display_info *dpyinfo = check_haiku_display_info (terminal); - int width, height; - BScreen_px_dim (&width, &height); + BScreen_px_dim (&width, &height); return make_fixnum (width / (dpyinfo->resx / 25.4)); } @@ -1921,14 +1970,20 @@ DEFUN ("x-display-visual-class", Fx_display_visual_class, doc: /* SKIP: real doc in xfns.c. */) (Lisp_Object terminal) { + int planes; + bool grayscale_p; + check_haiku_display_info (terminal); - int planes = be_get_display_planes (); + grayscale_p = be_is_display_grayscale (); + if (grayscale_p) + return Qstatic_gray; + planes = be_get_display_planes (); if (planes == 8) - return intern ("static-color"); + return Qstatic_color; - return intern ("true-color"); + return Qtrue_color; } DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0, @@ -1958,9 +2013,8 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0, f = decode_window_system_frame (frame); if (NILP (timeout)) - timeout = make_fixnum (5); - else - CHECK_FIXNAT (timeout); + timeout = Vx_show_tooltip_timeout; + CHECK_FIXNAT (timeout); if (NILP (dx)) dx = make_fixnum (5); @@ -2309,8 +2363,7 @@ DEFUN ("x-double-buffered-p", Fx_double_buffered_p, Sx_double_buffered_p, doc: /* SKIP: real doc in xfns.c. */) (Lisp_Object frame) { - struct frame *f = decode_live_frame (frame); - check_window_system (f); + struct frame *f = decode_window_system_frame (frame); return EmacsView_double_buffered_p (FRAME_HAIKU_VIEW (f)) ? Qt : Qnil; } @@ -2320,13 +2373,14 @@ DEFUN ("x-display-backing-store", Fx_display_backing_store, Sx_display_backing_s doc: /* SKIP: real doc in xfns.c. */) (Lisp_Object terminal) { + struct frame *f; + if (FRAMEP (terminal)) { - CHECK_LIVE_FRAME (terminal); - struct frame *f = decode_window_system_frame (terminal); + f = decode_window_system_frame (terminal); - if (FRAME_HAIKU_VIEW (f) && - EmacsView_double_buffered_p (FRAME_HAIKU_VIEW (f))) + if (FRAME_HAIKU_VIEW (f) + && EmacsView_double_buffered_p (FRAME_HAIKU_VIEW (f))) return FRAME_PARENT_FRAME (f) ? Qwhen_mapped : Qalways; else return Qnot_useful; @@ -2417,15 +2471,21 @@ Optional arg MUSTMATCH, if non-nil, means the returned file or directory must exist. Optional arg DIR_ONLY_P, if non-nil, means choose only directories. Optional arg SAVE_TEXT, if non-nil, specifies some text to show in the entry field. */) - (Lisp_Object prompt, Lisp_Object frame, - Lisp_Object dir, Lisp_Object mustmatch, - Lisp_Object dir_only_p, Lisp_Object save_text) + (Lisp_Object prompt, Lisp_Object frame, Lisp_Object dir, + Lisp_Object mustmatch, Lisp_Object dir_only_p, Lisp_Object save_text) { - if (!x_display_list) - error ("Be windowing not initialized"); + struct frame *f; + char *file_name; + Lisp_Object value; + + if (popup_activated_p) + error ("Trying to use a menu from within a menu-entry"); if (!NILP (dir)) - CHECK_STRING (dir); + { + CHECK_STRING (dir); + dir = ENCODE_FILE (dir); + } if (!NILP (save_text)) CHECK_STRING (save_text); @@ -2435,37 +2495,28 @@ Optional arg SAVE_TEXT, if non-nil, specifies some text to show in the entry fie CHECK_STRING (prompt); - CHECK_LIVE_FRAME (frame); - check_window_system (XFRAME (frame)); - - specpdl_ref idx = SPECPDL_INDEX (); - record_unwind_protect_void (unwind_popup); - - struct frame *f = XFRAME (frame); - - FRAME_DISPLAY_INFO (f)->focus_event_frame = f; + f = decode_window_system_frame (frame); ++popup_activated_p; - char *fn = be_popup_file_dialog (!NILP (mustmatch) || !NILP (dir_only_p), - !NILP (dir) ? SSDATA (ENCODE_UTF_8 (dir)) : NULL, - !NILP (mustmatch), !NILP (dir_only_p), - FRAME_HAIKU_WINDOW (f), - !NILP (save_text) ? SSDATA (ENCODE_UTF_8 (save_text)) : NULL, - SSDATA (ENCODE_UTF_8 (prompt)), - block_input, unblock_input, maybe_quit); + unrequest_sigio (); + file_name = be_popup_file_dialog (!NILP (mustmatch) || !NILP (dir_only_p), + !NILP (dir) ? SSDATA (dir) : NULL, + !NILP (mustmatch), !NILP (dir_only_p), + FRAME_HAIKU_WINDOW (f), + (!NILP (save_text) + ? SSDATA (ENCODE_UTF_8 (save_text)) : NULL), + SSDATA (ENCODE_UTF_8 (prompt)), + process_pending_signals); + request_sigio (); + --popup_activated_p; - unbind_to (idx, Qnil); + if (!file_name) + quit (); - block_input (); - BWindow_activate (FRAME_HAIKU_WINDOW (f)); - unblock_input (); - - if (!fn) - return Qnil; + value = build_string (file_name); + free (file_name); - Lisp_Object p = build_string_from_utf8 (fn); - free (fn); - return p; + return DECODE_FILE (value); } DEFUN ("haiku-put-resource", Fhaiku_put_resource, Shaiku_put_resource, @@ -2523,13 +2574,15 @@ DEFUN ("x-display-save-under", Fx_display_save_under, doc: /* SKIP: real doc in xfns.c. */) (Lisp_Object terminal) { + struct frame *f; check_haiku_display_info (terminal); if (FRAMEP (terminal)) { - struct frame *f = decode_window_system_frame (terminal); - return FRAME_HAIKU_VIEW (f) && EmacsView_double_buffered_p (FRAME_HAIKU_VIEW (f)) ? - Qt : Qnil; + f = decode_window_system_frame (terminal); + return ((FRAME_HAIKU_VIEW (f) + && EmacsView_double_buffered_p (FRAME_HAIKU_VIEW (f))) + ? Qt : Qnil); } return Qnil; @@ -2544,13 +2597,10 @@ means that if both frames are visible and the display areas of these frames overlap, FRAME1 (partially) obscures FRAME2. Some window managers may refuse to restack windows. */) - (Lisp_Object frame1, Lisp_Object frame2, Lisp_Object above) + (Lisp_Object frame1, Lisp_Object frame2, Lisp_Object above) { - struct frame *f1 = decode_live_frame (frame1); - struct frame *f2 = decode_live_frame (frame2); - - check_window_system (f1); - check_window_system (f2); + struct frame *f1 = decode_window_system_frame (frame1); + struct frame *f2 = decode_window_system_frame (frame2); block_input (); @@ -2596,6 +2646,30 @@ Some window managers may refuse to restack windows. */) return Qnil; } +DEFUN ("haiku-save-session-reply", Fhaiku_save_session_reply, + Shaiku_save_session_reply, 1, 1, 0, + doc: /* Reply to a `save-session' event. +QUIT-REPLY means whether or not all files were saved and program +termination should proceed. + +Calls to this function must be balanced by the amount of +`save-session' events received. This is done automatically, so do not +call this function yourself. */) + (Lisp_Object quit_reply) +{ + struct haiku_session_manager_reply reply; + reply.quit_reply = !NILP (quit_reply); + + block_input (); + unrequest_sigio (); + write_port (port_emacs_to_session_manager, 0, &reply, + sizeof reply); + request_sigio (); + unblock_input (); + + return Qnil; +} + frame_parm_handler haiku_frame_parm_handlers[] = { gui_set_autoraise, @@ -2643,7 +2717,7 @@ frame_parm_handler haiku_frame_parm_handlers[] = NULL, /* set skip taskbar */ haiku_set_no_focus_on_map, haiku_set_no_accept_focus, - NULL, /* set z group */ + haiku_set_z_group, haiku_set_override_redirect, gui_set_no_special_glyphs, gui_set_alpha_background, @@ -2661,6 +2735,10 @@ syms_of_haikufns (void) DEFSYM (Qwhen_mapped, "when-mapped"); DEFSYM (Qtooltip_reuse_hidden_frame, "tooltip-reuse-hidden-frame"); + DEFSYM (Qstatic_color, "static-color"); + DEFSYM (Qstatic_gray, "static-gray"); + DEFSYM (Qtrue_color, "true-color"); + defsubr (&Sx_hide_tip); defsubr (&Sxw_display_color_p); defsubr (&Sx_display_grayscale_p); @@ -2693,6 +2771,7 @@ syms_of_haikufns (void) defsubr (&Shaiku_frame_list_z_order); defsubr (&Sx_display_save_under); defsubr (&Shaiku_frame_restack); + defsubr (&Shaiku_save_session_reply); tip_timer = Qnil; staticpro (&tip_timer); @@ -2713,6 +2792,12 @@ syms_of_haikufns (void) doc: /* SKIP: real doc in xfns.c. */); Vx_cursor_fore_pixel = Qnil; + DEFVAR_LISP ("haiku-allowed-ui-colors", Vhaiku_allowed_ui_colors, + doc: /* Vector of UI colors that Emacs can look up from the system. +If this is set up incorrectly, Emacs can crash when encoutering an +invalid color. */); + Vhaiku_allowed_ui_colors = 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 b9f6dc2fe8e..f8cf45284d0 100644 --- a/src/haikufont.c +++ b/src/haikufont.c @@ -137,7 +137,7 @@ haikufont_apply_registry (struct haiku_font_pattern *pattern, for (l = 0; uniquifier[l]; ++l); - uint32_t *a = xmalloc (l * sizeof *a); + int *a = xmalloc (l * sizeof *a); for (l = 0; uniquifier[l]; ++l) a[l] = uniquifier[l]; @@ -149,6 +149,7 @@ haikufont_apply_registry (struct haiku_font_pattern *pattern, memcpy (&a[old_l], pattern->wanted_chars, (l - old_l) * sizeof *a); xfree (pattern->wanted_chars); } + pattern->specified |= FSPEC_WANTED; pattern->want_chars_len = l; pattern->wanted_chars = a; @@ -183,7 +184,7 @@ haikufont_get_fallback_entity (void) ASET (ent, FONT_FOUNDRY_INDEX, Qhaiku); ASET (ent, FONT_FAMILY_INDEX, Qnil); ASET (ent, FONT_ADSTYLE_INDEX, Qnil); - ASET (ent, FONT_REGISTRY_INDEX, Qutf_8); + ASET (ent, FONT_REGISTRY_INDEX, Qiso10646_1); ASET (ent, FONT_SIZE_INDEX, make_fixnum (0)); ASET (ent, FONT_AVGWIDTH_INDEX, make_fixnum (0)); ASET (ent, FONT_SPACING_INDEX, make_fixnum (FONT_SPACING_MONO)); @@ -207,8 +208,6 @@ haikufont_weight_to_lisp (int weight) { case HAIKU_THIN: return Qthin; - case HAIKU_ULTRALIGHT: - return Qultra_light; case HAIKU_EXTRALIGHT: return Qextra_light; case HAIKU_LIGHT: @@ -223,8 +222,6 @@ haikufont_weight_to_lisp (int weight) return Qbold; case HAIKU_EXTRA_BOLD: return Qextra_bold; - case HAIKU_ULTRA_BOLD: - return Qultra_bold; case HAIKU_BOOK: return Qbook; case HAIKU_HEAVY: @@ -245,14 +242,14 @@ haikufont_lisp_to_weight (Lisp_Object weight) if (EQ (weight, Qthin)) return HAIKU_THIN; if (EQ (weight, Qultra_light)) - return HAIKU_ULTRALIGHT; + return HAIKU_EXTRALIGHT; if (EQ (weight, Qextra_light)) return HAIKU_EXTRALIGHT; if (EQ (weight, Qlight)) return HAIKU_LIGHT; if (EQ (weight, Qsemi_light)) return HAIKU_SEMI_LIGHT; - if (EQ (weight, Qnormal)) + if (EQ (weight, Qnormal) || EQ (weight, Qregular)) return HAIKU_REGULAR; if (EQ (weight, Qsemi_bold)) return HAIKU_SEMI_BOLD; @@ -261,7 +258,7 @@ haikufont_lisp_to_weight (Lisp_Object weight) if (EQ (weight, Qextra_bold)) return HAIKU_EXTRA_BOLD; if (EQ (weight, Qultra_bold)) - return HAIKU_ULTRA_BOLD; + return HAIKU_EXTRA_BOLD; if (EQ (weight, Qbook)) return HAIKU_BOOK; if (EQ (weight, Qheavy)) @@ -273,7 +270,7 @@ haikufont_lisp_to_weight (Lisp_Object weight) if (EQ (weight, Qmedium)) return HAIKU_MEDIUM; - emacs_abort (); + return HAIKU_REGULAR; } static Lisp_Object @@ -296,15 +293,16 @@ haikufont_slant_to_lisp (enum haiku_font_slant slant) static enum haiku_font_slant haikufont_lisp_to_slant (Lisp_Object slant) { - if (EQ (slant, Qitalic) || - EQ (slant, Qreverse_italic)) + if (EQ (slant, Qitalic) + || EQ (slant, Qreverse_italic)) return SLANT_ITALIC; - if (EQ (slant, Qoblique) || - EQ (slant, Qreverse_oblique)) + if (EQ (slant, Qoblique) + || EQ (slant, Qreverse_oblique)) return SLANT_OBLIQUE; - if (EQ (slant, Qnormal)) + if (EQ (slant, Qnormal) || EQ (slant, Qregular)) return SLANT_REGULAR; - emacs_abort (); + + return SLANT_REGULAR; } static Lisp_Object @@ -348,7 +346,7 @@ haikufont_lisp_to_width (Lisp_Object lisp) return CONDENSED; if (EQ (lisp, Qsemi_condensed)) return SEMI_CONDENSED; - if (EQ (lisp, Qnormal)) + if (EQ (lisp, Qnormal) || EQ (lisp, Qregular)) return NORMAL_WIDTH; if (EQ (lisp, Qexpanded)) return EXPANDED; @@ -356,7 +354,8 @@ haikufont_lisp_to_width (Lisp_Object lisp) return EXTRA_EXPANDED; if (EQ (lisp, Qultra_expanded)) return ULTRA_EXPANDED; - emacs_abort (); + + return NORMAL_WIDTH; } static int @@ -382,15 +381,25 @@ haikufont_maybe_handle_special_family (Lisp_Object family, static Lisp_Object haikufont_pattern_to_entity (struct haiku_font_pattern *ptn) { - Lisp_Object ent = font_make_entity (); + Lisp_Object ent; + + ent = font_make_entity (); ASET (ent, FONT_TYPE_INDEX, Qhaiku); ASET (ent, FONT_FOUNDRY_INDEX, Qhaiku); ASET (ent, FONT_FAMILY_INDEX, Qdefault); ASET (ent, FONT_ADSTYLE_INDEX, Qnil); - ASET (ent, FONT_REGISTRY_INDEX, Qutf_8); + ASET (ent, FONT_REGISTRY_INDEX, Qiso10646_1); ASET (ent, FONT_SIZE_INDEX, make_fixnum (0)); ASET (ent, FONT_AVGWIDTH_INDEX, make_fixnum (0)); ASET (ent, FONT_SPACING_INDEX, make_fixnum (FONT_SPACING_MONO)); + + /* FONT_EXTRA_INDEX in a font entity can be a cons of two numbers + (STYLE . IDX) that tell Emacs how to open a font. */ + if (ptn->specified & FSPEC_INDICES) + ASET (ent, FONT_EXTRA_INDEX, + Fcons (make_fixnum (ptn->family_index), + make_fixnum (ptn->style_index))); + FONT_SET_STYLE (ent, FONT_WIDTH_INDEX, Qnormal); FONT_SET_STYLE (ent, FONT_WEIGHT_INDEX, Qnormal); FONT_SET_STYLE (ent, FONT_SLANT_INDEX, Qnormal); @@ -423,8 +432,57 @@ haikufont_pattern_to_entity (struct haiku_font_pattern *ptn) } static void -haikufont_spec_or_entity_to_pattern (Lisp_Object ent, - int list_p, +haikufont_pattern_from_object (struct haiku_font_pattern *pattern, + Lisp_Object font_object) +{ + Lisp_Object val; + + pattern->specified = 0; + + val = AREF (font_object, FONT_FAMILY_INDEX); + if (!NILP (val)) + { + pattern->specified |= FSPEC_FAMILY; + strncpy ((char *) &pattern->family, + SSDATA (SYMBOL_NAME (val)), + sizeof pattern->family - 1); + pattern->family[sizeof pattern->family - 1] = '\0'; + } + + val = AREF (font_object, FONT_ADSTYLE_INDEX); + if (!NILP (val)) + { + pattern->specified |= FSPEC_STYLE; + strncpy ((char *) &pattern->style, + SSDATA (SYMBOL_NAME (val)), + sizeof pattern->style - 1); + pattern->style[sizeof pattern->style - 1] = '\0'; + } + + val = FONT_WEIGHT_FOR_FACE (font_object); + if (!NILP (val) && !EQ (val, Qunspecified)) + { + pattern->specified |= FSPEC_WEIGHT; + pattern->weight = haikufont_lisp_to_weight (val); + } + + val = FONT_SLANT_FOR_FACE (font_object); + if (!NILP (val) && !EQ (val, Qunspecified)) + { + pattern->specified |= FSPEC_SLANT; + pattern->slant = haikufont_lisp_to_slant (val); + } + + val = FONT_WIDTH_FOR_FACE (font_object); + if (!NILP (val) && !EQ (val, Qunspecified)) + { + pattern->specified |= FSPEC_WIDTH; + pattern->width = haikufont_lisp_to_width (val); + } +} + +static void +haikufont_spec_or_entity_to_pattern (Lisp_Object ent, int list_p, struct haiku_font_pattern *ptn) { Lisp_Object tem; @@ -469,8 +527,9 @@ haikufont_spec_or_entity_to_pattern (Lisp_Object ent, } tem = AREF (ent, FONT_FAMILY_INDEX); - if (!NILP (tem) && !EQ (tem, Qunspecified) && - (list_p && !haikufont_maybe_handle_special_family (tem, ptn))) + if (!NILP (tem) && !EQ (tem, Qunspecified) + && (list_p + && !haikufont_maybe_handle_special_family (tem, ptn))) { ptn->specified |= FSPEC_FAMILY; strncpy ((char *) &ptn->family, @@ -591,27 +650,29 @@ haikufont_match (struct frame *f, Lisp_Object font_spec) static Lisp_Object haikufont_list (struct frame *f, Lisp_Object font_spec) { - block_input (); - Lisp_Object lst = Qnil; + Lisp_Object lst, tem; + struct haiku_font_pattern ptn, *found, *pt; + lst = Qnil; + + block_input (); /* Returning irrelevant results on receiving an OTF form will cause fontset.c to loop over and over, making displaying some characters very slow. */ - Lisp_Object tem = assq_no_quit (QCotf, AREF (font_spec, FONT_EXTRA_INDEX)); + tem = assq_no_quit (QCotf, AREF (font_spec, FONT_EXTRA_INDEX)); + if (CONSP (tem) && !NILP (XCDR (tem))) { unblock_input (); return Qnil; } - struct haiku_font_pattern ptn; haikufont_spec_or_entity_to_pattern (font_spec, 1, &ptn); - struct haiku_font_pattern *found = BFont_find (&ptn); + found = BFont_find (&ptn); haikufont_done_with_query_pattern (&ptn); if (found) { - for (struct haiku_font_pattern *pt = found; - pt; pt = pt->next) + for (pt = found; pt; pt = pt->next) lst = Fcons (haikufont_pattern_to_entity (pt), lst); haiku_font_pattern_free (found); } @@ -671,10 +732,11 @@ haikufont_open (struct frame *f, Lisp_Object font_entity, int x) struct haiku_font_pattern ptn; struct font *font; void *be_font; - Lisp_Object font_object; - Lisp_Object tem; + Lisp_Object font_object, tem, extra; + int px_size, min_width, max_width, + avg_width, height, space_width, ascent, + descent, underline_pos, underline_thickness; - block_input (); if (x <= 0) { /* Get pixel size from frame instead. */ @@ -682,19 +744,47 @@ haikufont_open (struct frame *f, Lisp_Object font_entity, int x) x = NILP (tem) ? 0 : XFIXNAT (tem); } - haikufont_spec_or_entity_to_pattern (font_entity, 1, &ptn); + extra = AREF (font_entity, FONT_EXTRA_INDEX); + + /* If the font's indices is already available, open the font using + those instead. */ + + if (CONSP (extra) && FIXNUMP (XCAR (extra)) + && FIXNUMP (XCDR (extra))) + { + block_input (); + be_font = be_open_font_at_index (XFIXNUM (XCAR (extra)), + XFIXNUM (XCDR (extra)), x); + unblock_input (); - if (BFont_open_pattern (&ptn, &be_font, x)) + if (!be_font) + return Qnil; + } + else { + block_input (); + haikufont_spec_or_entity_to_pattern (font_entity, 1, &ptn); + + if (BFont_open_pattern (&ptn, &be_font, x)) + { + haikufont_done_with_query_pattern (&ptn); + unblock_input (); + return Qnil; + } + haikufont_done_with_query_pattern (&ptn); unblock_input (); - return Qnil; } - haikufont_done_with_query_pattern (&ptn); + block_input (); + + /* `font_make_object' tries to treat the extra data as an alist. + There is never any real data here, so clear that field. */ + ASET (font_entity, FONT_EXTRA_INDEX, Qnil); font_object = font_make_object (VECSIZE (struct haikufont_info), font_entity, x); + ASET (font_entity, FONT_EXTRA_INDEX, extra); ASET (font_object, FONT_TYPE_INDEX, Qhaiku); font_info = (struct haikufont_info *) XFONT_OBJECT (font_object); @@ -721,14 +811,10 @@ haikufont_open (struct frame *f, Lisp_Object font_entity, int x) font_info->metrics = NULL; font_info->metrics_nrows = 0; - int px_size, min_width, max_width, - avg_width, height, space_width, ascent, - descent, underline_pos, underline_thickness; - - BFont_dat (be_font, &px_size, &min_width, - &max_width, &avg_width, &height, - &space_width, &ascent, &descent, - &underline_pos, &underline_thickness); + BFont_metrics (be_font, &px_size, &min_width, + &max_width, &avg_width, &height, + &space_width, &ascent, &descent, + &underline_pos, &underline_thickness); font->pixel_size = px_size; font->min_width = min_width; @@ -755,22 +841,31 @@ haikufont_open (struct frame *f, Lisp_Object font_entity, int x) static void haikufont_close (struct font *font) { + struct haikufont_info *info = (struct haikufont_info *) font; + int i; + if (font_data_structures_may_be_ill_formed ()) return; - struct haikufont_info *info = (struct haikufont_info *) font; block_input (); if (info && info->be_font) BFont_close (info->be_font); - for (int i = 0; i < info->metrics_nrows; i++) - if (info->metrics[i]) - xfree (info->metrics[i]); + for (i = 0; i < info->metrics_nrows; i++) + { + if (info->metrics[i]) + xfree (info->metrics[i]); + } + if (info->metrics) xfree (info->metrics); - for (int i = 0; i < 0x100; ++i) - if (info->glyphs[i]) - xfree (info->glyphs[i]); + + for (i = 0; i < 0x100; ++i) + { + if (info->glyphs[i]) + xfree (info->glyphs[i]); + } + xfree (info->glyphs); unblock_input (); } @@ -1071,6 +1166,89 @@ struct font_driver const haikufont_driver = .list_family = haikufont_list_family }; +static bool +haikufont_should_quit_popup (void) +{ + return !NILP (Vquit_flag); +} + +DEFUN ("x-select-font", Fx_select_font, Sx_select_font, 0, 2, 0, + doc: /* Read a font using a native dialog. +Return a font spec describing the font chosen by the user. + +FRAME is the frame on which to pop up the font chooser. If omitted or +nil, it defaults to the selected frame. +If EXCLUDE-PROPORTIONAL is non-nil, exclude proportional fonts +in the font selection dialog. */) + (Lisp_Object frame, Lisp_Object exclude_proportional) +{ + struct frame *f; + struct font *font; + Lisp_Object font_object; + haiku_font_family_or_style family, style; + int rc, size, initial_family, initial_style, initial_size; + struct haiku_font_pattern pattern; + Lisp_Object lfamily, lweight, lslant, lwidth, ladstyle, lsize; + + f = decode_window_system_frame (frame); + + if (popup_activated_p) + error ("Trying to use a menu from within a menu-entry"); + + initial_style = -1; + initial_family = -1; + initial_size = -1; + + font = FRAME_FONT (f); + + if (font) + { + XSETFONT (font_object, font); + + haikufont_pattern_from_object (&pattern, font_object); + be_find_font_indices (&pattern, &initial_family, + &initial_style); + haikufont_done_with_query_pattern (&pattern); + + initial_size = font->pixel_size; + } + + popup_activated_p++; + unrequest_sigio (); + rc = be_select_font (process_pending_signals, + haikufont_should_quit_popup, + &family, &style, &size, + !NILP (exclude_proportional), + initial_family, initial_style, + initial_size); + request_sigio (); + popup_activated_p--; + + if (!rc) + quit (); + + be_font_style_to_flags (style, &pattern); + + lfamily = build_string_from_utf8 (family); + lweight = (pattern.specified & FSPEC_WEIGHT + ? haikufont_weight_to_lisp (pattern.weight) + : Qunspecified); + lslant = (pattern.specified & FSPEC_SLANT + ? haikufont_slant_to_lisp (pattern.slant) + : Qunspecified); + lwidth = (pattern.specified & FSPEC_WIDTH + ? haikufont_width_to_lisp (pattern.width) + : Qunspecified); + ladstyle = (pattern.specified & FSPEC_STYLE + ? intern (pattern.style) : Qnil); + lsize = (size >= 0 ? make_fixnum (size) : Qnil); + + return CALLN (Ffont_spec, QCfamily, lfamily, + QCweight, lweight, QCslant, lslant, + QCwidth, lwidth, QCadstyle, ladstyle, + QCsize, lsize); +} + void syms_of_haikufont (void) { @@ -1090,10 +1268,19 @@ syms_of_haikufont (void) DEFSYM (Qexpanded, "expanded"); DEFSYM (Qextra_expanded, "extra-expanded"); DEFSYM (Qultra_expanded, "ultra-expanded"); + DEFSYM (Qregular, "regular"); DEFSYM (Qzh, "zh"); DEFSYM (Qko, "ko"); DEFSYM (Qjp, "jp"); +#ifdef USE_BE_CAIRO + Fput (Qhaiku, Qfont_driver_superseded_by, Qftcr); +#endif + font_cache = list (Qnil); staticpro (&font_cache); + + defsubr (&Sx_select_font); + + be_init_font_data (); } diff --git a/src/haikumenu.c b/src/haikumenu.c index 4cee69826da..9779c34a998 100644 --- a/src/haikumenu.c +++ b/src/haikumenu.c @@ -486,14 +486,19 @@ haiku_menu_show (struct frame *f, int x, int y, int menuflags, void free_frame_menubar (struct frame *f) { + void *mbar; + FRAME_MENU_BAR_LINES (f) = 0; FRAME_MENU_BAR_HEIGHT (f) = 0; FRAME_EXTERNAL_MENU_BAR (f) = 0; block_input (); - void *mbar = FRAME_HAIKU_MENU_BAR (f); + mbar = FRAME_HAIKU_MENU_BAR (f); + FRAME_HAIKU_MENU_BAR (f) = NULL; + if (mbar) BMenuBar_delete (mbar); + if (FRAME_OUTPUT_DATA (f)->menu_bar_open_p) --popup_activated_p; FRAME_OUTPUT_DATA (f)->menu_bar_open_p = 0; @@ -516,13 +521,20 @@ set_frame_menubar (struct frame *f, bool deep_p) { void *mbar = FRAME_HAIKU_MENU_BAR (f); void *view = FRAME_HAIKU_VIEW (f); - - int first_time_p = 0; + bool first_time_p = false; if (!mbar) { + block_input (); mbar = FRAME_HAIKU_MENU_BAR (f) = BMenuBar_new (view); first_time_p = 1; + + /* Now wait for the MENU_BAR_RESIZE event informing us of the + initial dimensions of that menu bar. */ + if (FRAME_VISIBLE_P (f)) + haiku_wait_for_event (f, MENU_BAR_RESIZE); + + unblock_input (); } Lisp_Object items; @@ -541,7 +553,6 @@ set_frame_menubar (struct frame *f, bool deep_p) if (!deep_p) { - FRAME_OUTPUT_DATA (f)->menu_up_to_date_p = 0; items = FRAME_MENU_BAR_ITEMS (f); Lisp_Object string; @@ -654,8 +665,6 @@ set_frame_menubar (struct frame *f, bool deep_p) set_buffer_internal_1 (prev); - FRAME_OUTPUT_DATA (f)->menu_up_to_date_p = 1; - /* If there has been no change in the Lisp-level contents of the menu bar, skip redisplaying it. Just exit. */ @@ -705,19 +714,11 @@ set_frame_menubar (struct frame *f, bool deep_p) void run_menu_bar_help_event (struct frame *f, int mb_idx) { - Lisp_Object frame; - Lisp_Object vec; - Lisp_Object help; - - block_input (); - if (!FRAME_OUTPUT_DATA (f)->menu_up_to_date_p) - { - unblock_input (); - return; - } + Lisp_Object frame, vec, help; XSETFRAME (frame, f); + block_input (); if (mb_idx < 0) { kbd_buffer_store_help_event (frame, Qnil); @@ -752,21 +753,65 @@ the position of the last non-menu event instead. */) (Lisp_Object frame) { struct frame *f = decode_window_system_frame (frame); + int rc; if (FRAME_EXTERNAL_MENU_BAR (f)) { block_input (); set_frame_menubar (f, 1); - BMenuBar_start_tracking (FRAME_HAIKU_MENU_BAR (f)); + rc = BMenuBar_start_tracking (FRAME_HAIKU_MENU_BAR (f)); unblock_input (); + + if (!rc) + return Qnil; + + FRAME_OUTPUT_DATA (f)->menu_bar_open_p = 1; + popup_activated_p += 1; } else + return call2 (Qpopup_menu, call0 (Qmouse_menu_bar_map), + last_nonmenu_event); + + return Qnil; +} + +void +haiku_activate_menubar (struct frame *f) +{ + int rc; + + if (!FRAME_HAIKU_MENU_BAR (f)) + return; + + set_frame_menubar (f, true); + + if (FRAME_OUTPUT_DATA (f)->saved_menu_event) { - return call2 (Qpopup_menu, call0 (Qmouse_menu_bar_map), - last_nonmenu_event); + block_input (); + rc = be_replay_menu_bar_event (FRAME_HAIKU_MENU_BAR (f), + FRAME_OUTPUT_DATA (f)->saved_menu_event); + xfree (FRAME_OUTPUT_DATA (f)->saved_menu_event); + FRAME_OUTPUT_DATA (f)->saved_menu_event = NULL; + unblock_input (); + + if (!rc) + return; + + FRAME_OUTPUT_DATA (f)->menu_bar_open_p = 1; + popup_activated_p += 1; } + else + { + block_input (); + rc = BMenuBar_start_tracking (FRAME_HAIKU_MENU_BAR (f)); + unblock_input (); - return Qnil; + if (!rc) + return; + + FRAME_OUTPUT_DATA (f)->menu_bar_open_p = 1; + popup_activated_p += 1; + } } void diff --git a/src/haikuselect.h b/src/haikuselect.h index bac9663c702..d4f331a9ccb 100644 --- a/src/haikuselect.h +++ b/src/haikuselect.h @@ -21,6 +21,8 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #ifdef __cplusplus #include <cstdio> +#else +#include <stdio.h> #endif #include <SupportDefs.h> @@ -33,89 +35,54 @@ enum haiku_clipboard }; #ifdef __cplusplus -#include <stdio.h> extern "C" { - extern void init_haiku_select (void); +extern void init_haiku_select (void); #endif - - /* Whether or not the selection was recently changed. */ - extern int selection_state_flag; - - /* Find a string with the MIME type TYPE in the system clipboard. */ - extern char * - BClipboard_find_system_data (const char *type, ssize_t *len); - - /* Ditto, but for the primary selection and not clipboard. */ - extern char * - BClipboard_find_primary_selection_data (const char *type, ssize_t *len); - - /* Ditto, this time for the secondary selection. */ - extern char * - BClipboard_find_secondary_selection_data (const char *type, ssize_t *len); - - extern void - BClipboard_set_system_data (const char *type, const char *data, ssize_t len, - bool clear); - - extern void - BClipboard_set_primary_selection_data (const char *type, const char *data, - ssize_t len, bool clear); - - extern void - BClipboard_set_secondary_selection_data (const char *type, const char *data, - ssize_t len, bool clear); - - extern void - BClipboard_system_targets (char **buf, int len); - - extern void - BClipboard_primary_targets (char **buf, int len); - - extern void - BClipboard_secondary_targets (char **buf, int len); - - extern bool - BClipboard_owns_clipboard (void); - - extern bool - BClipboard_owns_primary (void); - - extern bool BClipboard_owns_secondary (void); - - /* Free the returned data. */ - extern void BClipboard_free_data (void *ptr); - - extern int be_enum_message (void *message, int32 *tc, int32 index, - int32 *count, const char **name_return); - extern int be_get_message_data (void *message, const char *name, - int32 type_code, int32 index, - const void **buf_return, - ssize_t *size_return); - extern int be_get_refs_data (void *message, const char *name, - int32 index, char **path_buffer); - extern int be_get_point_data (void *message, const char *name, - int32 index, float *x, float *y); - extern uint32 be_get_message_type (void *message); - extern void be_set_message_type (void *message, uint32 what); - extern void *be_get_message_message (void *message, const char *name, - int32 index); - extern void *be_create_simple_message (void); - extern int be_add_message_data (void *message, const char *name, - int32 type_code, const void *buf, - ssize_t buf_size); - extern int be_add_refs_data (void *message, const char *name, - const char *filename); - extern int be_add_point_data (void *message, const char *name, - float x, float y); - extern int be_add_message_message (void *message, const char *name, - void *data); - extern int be_lock_clipboard_message (enum haiku_clipboard clipboard, - void **message_return, - bool clear); - extern void be_unlock_clipboard (enum haiku_clipboard clipboard, - bool discard); +/* Whether or not the selection was recently changed. */ + +/* Find a string with the MIME type TYPE in the system clipboard. */ +extern char *BClipboard_find_system_data (const char *, ssize_t *); +extern char *BClipboard_find_primary_selection_data (const char *, ssize_t *); +extern char *BClipboard_find_secondary_selection_data (const char *, ssize_t *); + +extern void BClipboard_set_system_data (const char *, const char *, ssize_t, bool); +extern void BClipboard_set_primary_selection_data (const char *, const char *, + ssize_t, bool); +extern void BClipboard_set_secondary_selection_data (const char *, const char *, + ssize_t, bool); + +extern void BClipboard_system_targets (char **, int); +extern void BClipboard_primary_targets (char **, int); +extern void BClipboard_secondary_targets (char **, int); + +extern bool BClipboard_owns_clipboard (void); +extern bool BClipboard_owns_primary (void); +extern bool BClipboard_owns_secondary (void); + +/* Free the returned data. */ +extern void BClipboard_free_data (void *); + +extern int be_enum_message (void *, int32 *, int32, int32 *, const char **); +extern int be_get_message_data (void *, const char *, int32, int32, + const void **, ssize_t *); +extern int be_get_refs_data (void *, const char *, int32, char **); +extern int be_get_point_data (void *, const char *, int32, float *, float *); +extern uint32 be_get_message_type (void *); +extern void be_set_message_type (void *, uint32); +extern void *be_get_message_message (void *, const char *, int32); +extern void *be_create_simple_message (void); +extern int be_add_message_data (void *, const char *, int32, const void *, ssize_t); +extern int be_add_refs_data (void *, const char *, const char *); +extern int be_add_point_data (void *, const char *, float, float); +extern int be_add_message_message (void *, const char *, void *); +extern int be_lock_clipboard_message (enum haiku_clipboard, void **, bool); +extern void be_unlock_clipboard (enum haiku_clipboard, bool); #ifdef __cplusplus }; #endif #endif /* _HAIKU_SELECT_H_ */ + +// Local Variables: +// eval: (setf (alist-get 'inextern-lang c-offsets-alist) 0) +// End: diff --git a/src/haikuterm.c b/src/haikuterm.c index f07e9e0b296..341288133e8 100644 --- a/src/haikuterm.c +++ b/src/haikuterm.c @@ -46,18 +46,14 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ struct haiku_display_info *x_display_list = NULL; extern frame_parm_handler haiku_frame_parm_handlers[]; +/* This is used to determine when to evict the font lookup cache, + which we do every 50 updates. */ +static int up_to_date_count; + static void **fringe_bmps; static int max_fringe_bmp = 0; static Lisp_Object rdb; - -struct unhandled_event -{ - struct unhandled_event *next; - enum haiku_event_type type; - uint8_t buffer[200]; -}; - static bool any_help_event_p; char * @@ -115,44 +111,7 @@ haiku_toolkit_position (struct frame *f, int x, int y, static void haiku_delete_terminal (struct terminal *terminal) { - struct haiku_display_info *dpyinfo = terminal->display_info.haiku; - struct terminal *t; - - if (!terminal->name) - return; - - block_input (); - - be_app_quit (); - delete_port (port_application_to_emacs); - - BCursor_delete (dpyinfo->text_cursor); - BCursor_delete (dpyinfo->nontext_cursor); - BCursor_delete (dpyinfo->modeline_cursor); - BCursor_delete (dpyinfo->hand_cursor); - BCursor_delete (dpyinfo->hourglass_cursor); - BCursor_delete (dpyinfo->horizontal_drag_cursor); - BCursor_delete (dpyinfo->vertical_drag_cursor); - BCursor_delete (dpyinfo->left_edge_cursor); - BCursor_delete (dpyinfo->top_left_corner_cursor); - BCursor_delete (dpyinfo->top_edge_cursor); - BCursor_delete (dpyinfo->top_right_corner_cursor); - BCursor_delete (dpyinfo->right_edge_cursor); - BCursor_delete (dpyinfo->bottom_right_corner_cursor); - BCursor_delete (dpyinfo->bottom_edge_cursor); - BCursor_delete (dpyinfo->bottom_left_corner_cursor); - BCursor_delete (dpyinfo->no_cursor); - - /* Close all frames and delete the generic struct terminal. */ - for (t = terminal_list; t; t = t->next_terminal) - { - if (t->type == output_haiku && t->display_info.haiku == dpyinfo) - { - delete_terminal (t); - break; - } - } - unblock_input (); + error ("The Haiku terminal cannot be deleted"); } static const char * @@ -177,23 +136,15 @@ get_string_resource (void *ignored, const char *name, const char *class) static void haiku_update_size_hints (struct frame *f) { - int base_width, base_height; - eassert (FRAME_HAIKU_P (f) && FRAME_HAIKU_WINDOW (f)); - if (f->tooltip) return; - base_width = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, 0); - base_height = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, 0); - block_input (); BWindow_set_size_alignment (FRAME_HAIKU_WINDOW (f), - frame_resize_pixelwise ? 1 : FRAME_COLUMN_WIDTH (f), - frame_resize_pixelwise ? 1 : FRAME_LINE_HEIGHT (f)); - BWindow_set_min_size (FRAME_HAIKU_WINDOW (f), base_width, - base_height - + FRAME_TOOL_BAR_HEIGHT (f) - + FRAME_MENU_BAR_HEIGHT (f)); + (frame_resize_pixelwise + ? 1 : FRAME_COLUMN_WIDTH (f)), + (frame_resize_pixelwise + ? 1 : FRAME_LINE_HEIGHT (f))); unblock_input (); } @@ -268,6 +219,13 @@ haiku_frame_up_to_date (struct frame *f) FRAME_MOUSE_UPDATE (f); if (FRAME_DIRTY_P (f) && !buffer_flipping_blocked_p ()) haiku_flip_buffers (f); + + up_to_date_count++; + if (up_to_date_count == 50) + { + be_evict_font_cache (); + up_to_date_count = 0; + } unblock_input (); } @@ -446,7 +404,7 @@ haiku_frame_raise_lower (struct frame *f, bool raise_p) } static struct frame * -haiku_mouse_or_wdesc_frame (void *window) +haiku_mouse_or_wdesc_frame (void *window, bool accept_tooltip) { struct frame *lm_f = (gui_mouse_grabbed (x_display_list) ? x_display_list->last_mouse_frame @@ -460,7 +418,7 @@ haiku_mouse_or_wdesc_frame (void *window) struct frame *w_f = haiku_window_to_frame (window); /* Do not return a tooltip frame. */ - if (!w_f || FRAME_TOOLTIP_P (w_f)) + if (!w_f || (FRAME_TOOLTIP_P (w_f) && !accept_tooltip)) return EQ (track_mouse, Qdropping) ? lm_f : NULL; else /* When dropping it would be probably nice to raise w_f @@ -647,35 +605,45 @@ haiku_calculate_relief_colors (struct glyph_string *s, uint32_t *rgbout_w, uint32_t *rgbout_b) { struct face *face = s->face; + double h, cs, l; + uint32_t rgbin; + struct haiku_output *di; - prepare_face_for_display (s->f, s->face); - - uint32_t rgbin = face->use_box_color_for_shadows_p - ? face->box_color : face->background; + rgbin = (face->use_box_color_for_shadows_p + ? face->box_color : face->background); + di = FRAME_OUTPUT_DATA (s->f); if (s->hl == DRAW_CURSOR) rgbin = FRAME_CURSOR_COLOR (s->f).pixel; - double h, cs, l; - rgb_color_hsl (rgbin, &h, &cs, &l); + if (di->relief_background != rgbin) + { + di->relief_background = rgbin & 0xffffffff; + + rgb_color_hsl (rgbin, &h, &cs, &l); + hsl_color_rgb (h, cs, fmin (1.0, fmax (0.2, l) * 0.6), + &di->black_relief_pixel); + hsl_color_rgb (h, cs, fmin (1.0, fmax (0.2, l) * 1.2), + &di->white_relief_pixel); + } - 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); + *rgbout_w = di->white_relief_pixel; + *rgbout_b = di->black_relief_pixel; } static void haiku_draw_relief_rect (struct glyph_string *s, int left_x, int top_y, int right_x, int bottom_y, - int hwidth, int vwidth, bool raised_p, bool top_p, bool bot_p, - bool left_p, bool right_p, + int hwidth, int vwidth, bool raised_p, bool top_p, + bool bot_p, bool left_p, bool right_p, struct haiku_rect *clip_rect, bool fancy_p) { - uint32_t color_white; - uint32_t color_black; + uint32_t color_white, color_black; + void *view; haiku_calculate_relief_colors (s, &color_white, &color_black); - void *view = FRAME_HAIKU_VIEW (s->f); + view = FRAME_HAIKU_VIEW (s->f); BView_SetHighColor (view, raised_p ? color_white : color_black); if (clip_rect) { @@ -752,15 +720,14 @@ haiku_draw_underwave (struct glyph_string *s, int width, int x) { int wave_height = 3, wave_length = 2; int y, dx, dy, odd, xmax; + float ax, ay, bx, by; + void *view = FRAME_HAIKU_VIEW (s->f); + dx = wave_length; dy = wave_height - 1; y = s->ybase - wave_height + 3; - - float ax, ay, bx, by; xmax = x + width; - void *view = FRAME_HAIKU_VIEW (s->f); - BView_StartClip (view); haiku_clip_to_string (s); BView_ClipToRect (view, x, y, width, wave_height); @@ -1096,6 +1063,8 @@ haiku_draw_glyph_string_foreground (struct glyph_string *s) for (i = 0; i < s->nchars; ++i) { struct glyph *g = s->first_glyph + i; + + BView_SetPenSize (view, 1); BView_StrokeRectangle (view, x, s->y, g->pixel_width, s->height); x += g->pixel_width; @@ -1127,6 +1096,7 @@ haiku_draw_glyphless_glyph_string_foreground (struct glyph_string *s) unsigned char2b[8]; int x, i, j; struct face *face = s->face; + unsigned long color; /* If first glyph of S has a left box line, start drawing the text of S to the right of that box line. */ @@ -1190,11 +1160,21 @@ haiku_draw_glyphless_glyph_string_foreground (struct glyph_string *s) s->ybase + glyph->slice.glyphless.lower_yoff, false); } + if (glyph->u.glyphless.method != GLYPHLESS_DISPLAY_THIN_SPACE) - BView_FillRectangle (FRAME_HAIKU_VIEW (s->f), - x, s->ybase - glyph->ascent, - glyph->pixel_width - 1, - glyph->ascent + glyph->descent - 1); + { + if (s->hl == DRAW_CURSOR) + haiku_merge_cursor_foreground (s, NULL, &color); + else + color = s->face->foreground; + + BView_SetHighColor (FRAME_HAIKU_VIEW (s->f), color); + BView_SetPenSize (FRAME_HAIKU_VIEW (s->f), 1); + BView_StrokeRectangle (FRAME_HAIKU_VIEW (s->f), + x, s->ybase - glyph->ascent, + glyph->pixel_width, + glyph->ascent + glyph->descent); + } x += glyph->pixel_width; } } @@ -1363,14 +1343,14 @@ haiku_draw_composite_glyph_string_foreground (struct glyph_string *s) /* Draw a rectangle for the composition if the font for the very first character of the composition could not be loaded. */ - if (s->font_not_found_p && !s->cmp_from) { if (s->hl == DRAW_CURSOR) BView_SetHighColor (view, FRAME_OUTPUT_DATA (s->f)->cursor_fg); else BView_SetHighColor (view, s->face->foreground); - BView_StrokeRectangle (view, s->x, s->y, s->width - 1, s->height - 1); + BView_StrokeRectangle (view, s->x, s->y, + s->width, s->height); } else if (!s->first_glyph->u.cmp.automatic) { @@ -2009,7 +1989,8 @@ haiku_draw_window_cursor (struct window *w, static void haiku_show_hourglass (struct frame *f) { - if (FRAME_OUTPUT_DATA (f)->hourglass_p) + if (FRAME_TOOLTIP_P (f) + || FRAME_OUTPUT_DATA (f)->hourglass_p) return; block_input (); @@ -2024,7 +2005,8 @@ haiku_show_hourglass (struct frame *f) static void haiku_hide_hourglass (struct frame *f) { - if (!FRAME_OUTPUT_DATA (f)->hourglass_p) + if (FRAME_TOOLTIP_P (f) + || !FRAME_OUTPUT_DATA (f)->hourglass_p) return; block_input (); @@ -2663,8 +2645,9 @@ haiku_flush (struct frame *f) static void haiku_define_frame_cursor (struct frame *f, Emacs_Cursor cursor) { - if (f->tooltip) + if (FRAME_TOOLTIP_P (f)) return; + block_input (); if (!f->pointer_invisible && FRAME_HAIKU_VIEW (f) && !FRAME_OUTPUT_DATA (f)->hourglass_p) @@ -2785,44 +2768,69 @@ haiku_make_fullscreen_consistent (struct frame *f) } static void -flush_dirty_back_buffers (void) +haiku_flush_dirty_back_buffer_on (struct frame *f) { - block_input (); - Lisp_Object tail, frame; - FOR_EACH_FRAME (tail, frame) + if (!FRAME_GARBAGED_P (f) + && !buffer_flipping_blocked_p () + && FRAME_DIRTY_P (f)) + haiku_flip_buffers (f); +} + +/* N.B. that support for TYPE must be explictly added to + haiku_read_socket. */ +void +haiku_wait_for_event (struct frame *f, int type) +{ + int input_blocked_to; + object_wait_info info; + specpdl_ref depth; + + input_blocked_to = interrupt_input_blocked; + info.object = port_application_to_emacs; + info.type = B_OBJECT_TYPE_PORT; + info.events = B_EVENT_READ; + + depth = SPECPDL_INDEX (); + specbind (Qinhibit_quit, Qt); + + FRAME_OUTPUT_DATA (f)->wait_for_event_type = type; + + while (FRAME_OUTPUT_DATA (f)->wait_for_event_type == type) { - struct frame *f = XFRAME (frame); - if (FRAME_LIVE_P (f) && - FRAME_HAIKU_P (f) && - FRAME_HAIKU_WINDOW (f) && - !FRAME_GARBAGED_P (f) && - !buffer_flipping_blocked_p () && - FRAME_DIRTY_P (f)) - haiku_flip_buffers (f); + if (wait_for_objects (&info, 1) < B_OK) + continue; + + pending_signals = true; + /* This will call the read_socket_hook. */ + totally_unblock_input (); + interrupt_input_blocked = input_blocked_to; + info.events = B_EVENT_READ; } - unblock_input (); + + unbind_to (depth, Qnil); } static int haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) { - block_input (); - int message_count = 0; - static void *buf = NULL; + int message_count; + static void *buf; ssize_t b_size; - struct unhandled_event *unhandled_events = NULL; - int button_or_motion_p; - int need_flush = 0; - int do_help = 0; + int button_or_motion_p, do_help; + enum haiku_event_type type; + struct input_event inev, inev2; + message_count = 0; + button_or_motion_p = 0; + do_help = 0; + buf = NULL; + + block_input (); if (!buf) buf = xmalloc (200); haiku_read_size (&b_size, false); while (b_size >= 0) { - enum haiku_event_type type; - struct input_event inev, inev2; - if (b_size > 200) emacs_abort (); @@ -2834,7 +2842,6 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) inev2.arg = Qnil; button_or_motion_p = 0; - haiku_read (&type, buf, b_size); switch (type) @@ -2901,7 +2908,6 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) continue; expose_frame (f, b->x, b->y, b->width, b->height); - haiku_clear_under_internal_border (f); break; } @@ -2911,6 +2917,9 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) Mouse_HLInfo *hlinfo = &x_display_list->mouse_highlight; struct frame *f = haiku_window_to_frame (b->window); + if (!f) + continue; + /* If mouse-highlight is an integer, input clears out mouse highlighting. */ if (!hlinfo->mouse_face_hidden && FIXNUMP (Vmouse_highlight) @@ -2920,12 +2929,9 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) { clear_mouse_face (hlinfo); hlinfo->mouse_face_hidden = true; - need_flush = 1; + haiku_flush_dirty_back_buffer_on (f); } - if (!f) - continue; - inev.code = b->keysym ? b->keysym : b->multibyte_char; if (b->keysym) @@ -2954,8 +2960,8 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) if (!f) continue; - if ((x_display_list->focus_event_frame != f && b->activated_p) || - (x_display_list->focus_event_frame == f && !b->activated_p)) + if ((x_display_list->focus_event_frame != f && b->activated_p) + || (x_display_list->focus_event_frame == f && !b->activated_p)) { haiku_new_focus_frame (b->activated_p ? f : NULL); if (b->activated_p) @@ -2988,7 +2994,7 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) case MOUSE_MOTION: { struct haiku_mouse_motion_event *b = buf; - struct frame *f = haiku_mouse_or_wdesc_frame (b->window); + struct frame *f = haiku_mouse_or_wdesc_frame (b->window, true); Mouse_HLInfo *hlinfo = &x_display_list->mouse_highlight; Lisp_Object frame; @@ -3003,7 +3009,6 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) if (any_help_event_p) do_help = -1; - break; } @@ -3016,7 +3021,7 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) { hlinfo->mouse_face_hidden = false; clear_mouse_face (hlinfo); - need_flush = 1; + haiku_flush_dirty_back_buffer_on (f); } if (b->just_exited_p) @@ -3029,7 +3034,7 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) clear_mouse_face (hlinfo); hlinfo->mouse_face_mouse_frame = 0; - need_flush = 1; + haiku_flush_dirty_back_buffer_on (f); } if (f->auto_lower && !popup_activated_p @@ -3100,7 +3105,6 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) || b->y < r.y || b->y >= r.y + r.height) { f->mouse_moved = true; - dpyinfo->last_mouse_scroll_bar = NULL; note_mouse_highlight (f, b->x, b->y); remember_mouse_glyph (f, b->x, b->y, &FRAME_DISPLAY_INFO (f)->last_mouse_glyph); @@ -3144,7 +3148,8 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) /* It doesn't make sense to show tooltips when another program is dragging stuff over us. */ - do_help = -1; + if (any_help_event_p || do_help) + do_help = -1; if (!be_drag_and_drop_in_progress ()) { @@ -3163,14 +3168,14 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) } if (FRAME_DIRTY_P (f)) - need_flush = 1; + haiku_flush_dirty_back_buffer_on (f); break; } case BUTTON_UP: case BUTTON_DOWN: { struct haiku_button_event *b = buf; - struct frame *f = haiku_mouse_or_wdesc_frame (b->window); + struct frame *f = haiku_mouse_or_wdesc_frame (b->window, false); Lisp_Object tab_bar_arg = Qnil; int tab_bar_p = 0, tool_bar_p = 0; bool up_okay_p = false; @@ -3201,7 +3206,7 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) { tab_bar_arg = handle_tab_bar_click (f, x, y, type == BUTTON_DOWN, inev.modifiers); - need_flush = 1; + haiku_flush_dirty_back_buffer_on (f); } } @@ -3221,7 +3226,7 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) { handle_tool_bar_click (f, x, y, type == BUTTON_DOWN, inev.modifiers); - need_flush = 1; + haiku_flush_dirty_back_buffer_on (f); } } @@ -3490,7 +3495,6 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) break; } - case MENU_BAR_RESIZE: { struct haiku_menu_bar_resize_event *b = buf; @@ -3499,11 +3503,15 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) if (!f || !FRAME_EXTERNAL_MENU_BAR (f)) continue; + if (FRAME_OUTPUT_DATA (f)->wait_for_event_type + == MENU_BAR_RESIZE) + FRAME_OUTPUT_DATA (f)->wait_for_event_type = -1; + int old_height = FRAME_MENU_BAR_HEIGHT (f); - FRAME_MENU_BAR_HEIGHT (f) = b->height + 1; - FRAME_MENU_BAR_LINES (f) = - (b->height + FRAME_LINE_HEIGHT (f)) / FRAME_LINE_HEIGHT (f); + FRAME_MENU_BAR_HEIGHT (f) = b->height; + FRAME_MENU_BAR_LINES (f) + = (b->height + FRAME_LINE_HEIGHT (f)) / FRAME_LINE_HEIGHT (f); if (old_height != b->height) { @@ -3512,6 +3520,21 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) } break; } + case MENU_BAR_CLICK: + { + struct haiku_menu_bar_click_event *b = buf; + struct frame *f = haiku_window_to_frame (b->window); + + if (!f || !FRAME_EXTERNAL_MENU_BAR (f)) + continue; + + if (!FRAME_OUTPUT_DATA (f)->saved_menu_event) + FRAME_OUTPUT_DATA (f)->saved_menu_event = xmalloc (sizeof *b); + *FRAME_OUTPUT_DATA (f)->saved_menu_event = *b; + inev.kind = MENU_BAR_ACTIVATE_EVENT; + XSETFRAME (inev.frame_or_window, f); + break; + } case MENU_BAR_OPEN: case MENU_BAR_CLOSE: { @@ -3523,35 +3546,14 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) if (type == MENU_BAR_OPEN) { - /* 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), false, 0, 0, 0, 0); - /* This shouldn't be here, but nsmenu does it, so - it should probably be safe. */ - int was_waiting_for_input_p = waiting_for_input; - if (waiting_for_input) - waiting_for_input = 0; - set_frame_menubar (f, 1); - 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 { if (!popup_activated_p) emacs_abort (); + if (FRAME_OUTPUT_DATA (f)->menu_bar_open_p) { FRAME_OUTPUT_DATA (f)->menu_bar_open_p = 0; @@ -3568,22 +3570,8 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) if (!f || !FRAME_EXTERNAL_MENU_BAR (f)) continue; - if (FRAME_OUTPUT_DATA (f)->menu_up_to_date_p) - find_and_call_menu_selection (f, f->menu_bar_items_used, - f->menu_bar_vector, b->ptr); - break; - } - case FILE_PANEL_EVENT: - { - if (!popup_activated_p) - continue; - - struct unhandled_event *ev = xmalloc (sizeof *ev); - ev->next = unhandled_events; - ev->type = type; - memcpy (&ev->buffer, buf, 200); - - unhandled_events = ev; + find_and_call_menu_selection (f, f->menu_bar_items_used, + f->menu_bar_vector, b->ptr); break; } case MENU_BAR_HELP_EVENT: @@ -3594,12 +3582,11 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) continue; struct frame *f = haiku_window_to_frame (b->window); - if (!f || !FRAME_EXTERNAL_MENU_BAR (f) || - !FRAME_OUTPUT_DATA (f)->menu_bar_open_p) + if (!f || !FRAME_EXTERNAL_MENU_BAR (f) + || !FRAME_OUTPUT_DATA (f)->menu_bar_open_p) continue; run_menu_bar_help_event (f, b->mb_idx); - break; } case ZOOM_EVENT: @@ -3637,6 +3624,9 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) break; } case APP_QUIT_REQUESTED_EVENT: + inev.kind = SAVE_SESSION_EVENT; + inev.arg = Qt; + break; case KEY_UP: case DUMMY_EVENT: default: @@ -3666,14 +3656,6 @@ 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, false); - struct unhandled_event *old = ev; - ev = old->next; - xfree (old); - } - if (do_help && !(hold_quit && hold_quit->kind != NO_EVENT)) { Lisp_Object help_frame = Qnil; @@ -3696,9 +3678,6 @@ haiku_read_socket (struct terminal *terminal, struct input_event *hold_quit) } } - if (need_flush) - flush_dirty_back_buffers (); - unblock_input (); return message_count; @@ -3735,10 +3714,13 @@ haiku_flash (struct frame *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; + object_wait_info info; + bigtime_t wakeup; - delay = make_timespec (0, 150 * 1000 * 1000); - wakeup = timespec_add (current_timespec (), delay); + info.object = port_application_to_emacs; + info.type = B_OBJECT_TYPE_PORT; + info.events = B_EVENT_READ; + wakeup = system_time () + 150000; BView_draw_lock (view, true, 0, 0, FRAME_PIXEL_WIDTH (f), FRAME_PIXEL_HEIGHT (f)); @@ -3772,17 +3754,17 @@ haiku_flash (struct frame *f) available. */ while (!detect_input_pending ()) { - current = current_timespec (); - /* Break if result would not be positive. */ - if (timespec_cmp (wakeup, current) <= 0) + if (wakeup < system_time ()) 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); + wait_for_objects_etc (&info, 1, B_ABSOLUTE_TIMEOUT, wakeup); + + if (info.events & B_EVENT_READ) + break; + + info.events = B_EVENT_READ; } BView_draw_lock (view, true, 0, 0, FRAME_PIXEL_WIDTH (f), @@ -3835,12 +3817,12 @@ haiku_toggle_invisible_pointer (struct frame *f, bool invisible_p) { void *view = FRAME_HAIKU_VIEW (f); - if (view) + if (view && !FRAME_TOOLTIP_P (f)) { block_input (); - BView_set_view_cursor (view, invisible_p ? - FRAME_OUTPUT_DATA (f)->no_cursor : - FRAME_OUTPUT_DATA (f)->current_cursor); + BView_set_view_cursor (view, (invisible_p + ? FRAME_OUTPUT_DATA (f)->no_cursor + : FRAME_OUTPUT_DATA (f)->current_cursor)); f->pointer_invisible = invisible_p; unblock_input (); } @@ -3919,6 +3901,7 @@ haiku_create_terminal (struct haiku_display_info *dpyinfo) terminal->toggle_invisible_pointer_hook = haiku_toggle_invisible_pointer; terminal->fullscreen_hook = haiku_fullscreen; terminal->toolkit_position_hook = haiku_toolkit_position; + terminal->activate_menubar_hook = haiku_activate_menubar; return terminal; } @@ -3928,38 +3911,36 @@ haiku_term_init (void) { struct haiku_display_info *dpyinfo; struct terminal *terminal; - - Lisp_Object color_file, color_map; + Lisp_Object color_file, color_map, system_name; + ptrdiff_t nbytes; + void *name_buffer; block_input (); - Fset_input_interrupt_mode (Qt); + Fset_input_interrupt_mode (Qt); baud_rate = 19200; - dpyinfo = xzalloc (sizeof *dpyinfo); - haiku_io_init (); - if (port_application_to_emacs < B_OK) + if (port_application_to_emacs < B_OK + || port_emacs_to_session_manager < B_OK) emacs_abort (); color_file = Fexpand_file_name (build_string ("rgb.txt"), Fsymbol_value (intern ("data-directory"))); - color_map = Fx_load_color_file (color_file); + if (NILP (color_map)) fatal ("Could not read %s.\n", SDATA (color_file)); dpyinfo->color_map = color_map; - dpyinfo->display = BApplication_setup (); - - BScreen_res (&dpyinfo->resx, &dpyinfo->resy); - dpyinfo->next = x_display_list; dpyinfo->n_planes = be_get_display_planes (); x_display_list = dpyinfo; + BScreen_res (&dpyinfo->resx, &dpyinfo->resy); + terminal = haiku_create_terminal (dpyinfo); if (current_kboard == initial_kboard) current_kboard = terminal->kboard; @@ -4006,6 +3987,23 @@ haiku_term_init (void) BCursor_from_id (CURSOR_ID_NO_CURSOR)); #undef ASSIGN_CURSOR + system_name = Fsystem_name (); + + if (STRINGP (system_name)) + { + nbytes = sizeof "GNU Emacs" + sizeof " at "; + + if (INT_ADD_WRAPV (nbytes, SBYTES (system_name), &nbytes)) + memory_full (SIZE_MAX); + + name_buffer = alloca (nbytes); + sprintf (name_buffer, "%s%s%s", "GNU Emacs", + " at ", SDATA (system_name)); + dpyinfo->default_name = build_string (name_buffer); + } + else + dpyinfo->default_name = build_string ("GNU Emacs"); + unblock_input (); return dpyinfo; @@ -4073,7 +4071,10 @@ void mark_haiku_display (void) { if (x_display_list) - mark_object (x_display_list->color_map); + { + mark_object (x_display_list->color_map); + mark_object (x_display_list->default_name); + } } void @@ -4230,7 +4231,6 @@ This is either one of the symbols `shift', `control', `command', and Setting it to any other value is equivalent to `shift'. */); Vhaiku_shift_keysym = Qnil; - DEFSYM (Qx_use_underline_position_properties, "x-use-underline-position-properties"); diff --git a/src/haikuterm.h b/src/haikuterm.h index 586df285751..30b474b1e1d 100644 --- a/src/haikuterm.h +++ b/src/haikuterm.h @@ -36,8 +36,6 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ extern int popup_activated_p; -extern void be_app_quit (void); - struct haikufont_info { struct font font; @@ -83,6 +81,7 @@ struct haiku_display_info int color_p; Lisp_Object rdb; + Lisp_Object default_name; Emacs_Cursor vertical_scroll_bar_cursor; Emacs_Cursor horizontal_scroll_bar_cursor; @@ -98,8 +97,6 @@ struct haiku_display_info struct haiku_rect last_mouse_glyph; - void *last_mouse_scroll_bar; - haiku display; double resx, resy; @@ -128,6 +125,8 @@ struct haiku_display_info struct haiku_output { + struct haiku_display_info *display_info; + Emacs_Cursor text_cursor; Emacs_Cursor nontext_cursor; Emacs_Cursor modeline_cursor; @@ -144,43 +143,55 @@ struct haiku_output Emacs_Cursor bottom_edge_cursor; Emacs_Cursor bottom_left_corner_cursor; Emacs_Cursor no_cursor; - Emacs_Cursor current_cursor; - struct haiku_display_info *display_info; - - int baseline_offset; - int fontset; - Emacs_Color cursor_color; - Window window_desc, parent_desc; - char explicit_parent; - - int titlebar_height; - int toolbar_height; + Window parent_desc; haiku window; haiku view; haiku menubar; - int menu_up_to_date_p; - int zoomed_p; - - int menu_bar_open_p; + int fontset; + int baseline_offset; - struct font *font; + bool_bf zoomed_p : 1; + bool_bf hourglass_p : 1; + bool_bf menu_bar_open_p : 1; - int hourglass_p; - uint32_t cursor_fg; + /* Whether or not there is data in a back buffer that hasn't been + displayed yet. */ bool dirty_p; + struct font *font; + /* The pending position we're waiting for. */ int pending_top, pending_left; /* Whether or not adjust_frame_size and haiku_set_offset have yet been called by haiku_create_frame. */ bool configury_done; + + /* The default cursor foreground color. */ + uint32_t cursor_fg; + + /* If non-NULL, the last menu bar click event received. */ + struct haiku_menu_bar_click_event *saved_menu_event; + + /* The type of any event that's being waited for. */ + int wait_for_event_type; + + /* The "dark" color of the current relief. */ + uint32_t black_relief_pixel; + + /* The "light" color of the current relief. */ + uint32_t white_relief_pixel; + + /* The background for which the relief colors above were computed. + They are changed only when a different background is involved. + -1 means no color has been computed. */ + long relief_background; }; struct x_output @@ -231,23 +242,25 @@ struct scroll_bar /* True if the scroll bar is horizontal. */ bool horizontal; + /* The amount of units taken up by the thumb, which represents the + portion of the buffer currently on screen. */ int page_size; }; #define XSCROLL_BAR(vec) ((struct scroll_bar *) XVECTOR (vec)) -#define FRAME_DIRTY_P(f) (FRAME_OUTPUT_DATA (f)->dirty_p) -#define MAKE_FRAME_DIRTY(f) (FRAME_DIRTY_P (f) = 1) -#define FRAME_OUTPUT_DATA(f) ((f)->output_data.haiku) -#define FRAME_HAIKU_WINDOW(f) (FRAME_OUTPUT_DATA (f)->window) -#define FRAME_HAIKU_VIEW(f) ((MAKE_FRAME_DIRTY (f)), FRAME_OUTPUT_DATA (f)->view) -#define FRAME_HAIKU_MENU_BAR(f) (FRAME_OUTPUT_DATA (f)->menubar) -#define FRAME_DISPLAY_INFO(f) (FRAME_OUTPUT_DATA (f)->display_info) -#define FRAME_FONT(f) (FRAME_OUTPUT_DATA (f)->font) -#define FRAME_FONTSET(f) (FRAME_OUTPUT_DATA (f)->fontset) -#define FRAME_NATIVE_WINDOW(f) (FRAME_OUTPUT_DATA (f)->window) -#define FRAME_BASELINE_OFFSET(f) (FRAME_OUTPUT_DATA (f)->baseline_offset) -#define FRAME_CURSOR_COLOR(f) (FRAME_OUTPUT_DATA (f)->cursor_color) +#define FRAME_DIRTY_P(f) (FRAME_OUTPUT_DATA (f)->dirty_p) +#define MAKE_FRAME_DIRTY(f) (FRAME_DIRTY_P (f) = 1) +#define FRAME_OUTPUT_DATA(f) ((f)->output_data.haiku) +#define FRAME_HAIKU_WINDOW(f) (FRAME_OUTPUT_DATA (f)->window) +#define FRAME_HAIKU_VIEW(f) ((MAKE_FRAME_DIRTY (f)), FRAME_OUTPUT_DATA (f)->view) +#define FRAME_HAIKU_MENU_BAR(f) (FRAME_OUTPUT_DATA (f)->menubar) +#define FRAME_DISPLAY_INFO(f) (FRAME_OUTPUT_DATA (f)->display_info) +#define FRAME_FONT(f) (FRAME_OUTPUT_DATA (f)->font) +#define FRAME_FONTSET(f) (FRAME_OUTPUT_DATA (f)->fontset) +#define FRAME_NATIVE_WINDOW(f) (FRAME_OUTPUT_DATA (f)->window) +#define FRAME_BASELINE_OFFSET(f) (FRAME_OUTPUT_DATA (f)->baseline_offset) +#define FRAME_CURSOR_COLOR(f) (FRAME_OUTPUT_DATA (f)->cursor_color) #ifdef USE_BE_CAIRO #define FRAME_CR_CONTEXT(f) \ @@ -268,52 +281,52 @@ extern void haiku_visualize_frame (struct frame *); extern void haiku_unvisualize_frame (struct frame *); extern void haiku_set_offset (struct frame *, int, int, int); extern void haiku_set_frame_visible_invisible (struct frame *, bool); -extern void haiku_free_frame_resources (struct frame *f); -extern void haiku_scroll_bar_remove (struct scroll_bar *bar); -extern void haiku_clear_under_internal_border (struct frame *f); -extern void haiku_set_name (struct frame *f, Lisp_Object name, bool explicit_p); +extern void haiku_free_frame_resources (struct frame *); +extern void haiku_scroll_bar_remove (struct scroll_bar *); +extern void haiku_clear_under_internal_border (struct frame *); +extern void haiku_set_name (struct frame *, Lisp_Object, bool); extern Lisp_Object haiku_message_to_lisp (void *); extern struct haiku_display_info *haiku_term_init (void); extern void mark_haiku_display (void); -extern int haiku_get_color (const char *name, Emacs_Color *color); -extern void haiku_set_background_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval); -extern void haiku_set_cursor_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval); -extern void haiku_set_cursor_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval); -extern void haiku_set_internal_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval); -extern void haiku_change_tab_bar_height (struct frame *f, int height); -extern void haiku_change_tool_bar_height (struct frame *f, int height); +extern int haiku_get_color (const char *, Emacs_Color *); +extern void haiku_set_background_color (struct frame *, Lisp_Object, Lisp_Object); +extern void haiku_set_cursor_color (struct frame *, Lisp_Object, Lisp_Object); +extern void haiku_set_cursor_type (struct frame *, Lisp_Object, Lisp_Object); +extern void haiku_set_internal_border_width (struct frame *, Lisp_Object, Lisp_Object); +extern void haiku_change_tab_bar_height (struct frame *, int); +extern void haiku_change_tool_bar_height (struct frame *, int); -extern void haiku_query_color (uint32_t col, Emacs_Color *color); +extern void haiku_query_color (uint32_t, Emacs_Color *); -extern unsigned long haiku_get_pixel (haiku bitmap, int x, int y); -extern void haiku_put_pixel (haiku bitmap, int x, int y, unsigned long pixel); +extern unsigned long haiku_get_pixel (haiku, int, int); +extern void haiku_put_pixel (haiku, int, int, unsigned long); -extern Lisp_Object haiku_menu_show (struct frame *f, int x, int y, int menu_flags, - Lisp_Object title, const char **error_name); -extern Lisp_Object haiku_popup_dialog (struct frame *f, Lisp_Object header, Lisp_Object contents); +extern Lisp_Object haiku_menu_show (struct frame *, int, int, int, + Lisp_Object, const char **); +extern Lisp_Object haiku_popup_dialog (struct frame *, Lisp_Object, Lisp_Object); +extern void haiku_activate_menubar (struct frame *); +extern void haiku_wait_for_event (struct frame *, int); extern void haiku_note_drag_motion (void); -extern void initialize_frame_menubar (struct frame *f); +extern void initialize_frame_menubar (struct frame *); -extern void run_menu_bar_help_event (struct frame *f, int mb_idx); -extern void put_xrm_resource (Lisp_Object name, Lisp_Object val); +extern void run_menu_bar_help_event (struct frame *, int); +extern void put_xrm_resource (Lisp_Object, Lisp_Object); #ifdef HAVE_NATIVE_IMAGE_API -extern bool haiku_can_use_native_image_api (Lisp_Object type); -extern int haiku_load_image (struct frame *f, struct image *img, - Lisp_Object spec_file, Lisp_Object spec_data); +extern bool haiku_can_use_native_image_api (Lisp_Object); +extern int haiku_load_image (struct frame *, struct image *, + Lisp_Object, Lisp_Object); extern void syms_of_haikuimage (void); #endif #ifdef USE_BE_CAIRO -extern cairo_t * -haiku_begin_cr_clip (struct frame *f, struct glyph_string *s); +extern cairo_t *haiku_begin_cr_clip (struct frame *, struct glyph_string *); -extern void -haiku_end_cr_clip (cairo_t *cr); +extern void haiku_end_cr_clip (cairo_t *); #endif extern void haiku_merge_cursor_foreground (struct glyph_string *, unsigned long *, diff --git a/src/image.c b/src/image.c index 45de7ae83d3..e4b56e29cff 100644 --- a/src/image.c +++ b/src/image.c @@ -11316,7 +11316,7 @@ svg_load_image (struct frame *f, struct image *img, char *contents, #endif /* FIXME: Use error->message so the user knows what is the actual problem with the image. */ - image_error ("Error parsing SVG image `%s'", img->spec); + image_error ("Error parsing SVG image"); g_clear_error (&err); return 0; } diff --git a/src/indent.c b/src/indent.c index d5ad02ae3af..acbb9dc9723 100644 --- a/src/indent.c +++ b/src/indent.c @@ -2209,7 +2209,10 @@ whether or not it is currently displayed in some window. */) } else it_overshoot_count = - !(it.method == GET_FROM_IMAGE || it.method == GET_FROM_STRETCH); + /* If image_id is negative, it's a fringe bitmap, which by + definition doesn't affect display in the text area. */ + !((it.method == GET_FROM_IMAGE && it.image_id >= 0) + || it.method == GET_FROM_STRETCH); if (start_x_given) { diff --git a/src/keyboard.c b/src/keyboard.c index e569f8f34c9..70908120cb0 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -1059,7 +1059,7 @@ Default value of `command-error-function'. */) print_error_message (data, Qexternal_debugging_output, SSDATA (context), signal); Fterpri (Qexternal_debugging_output, Qnil); - Fkill_emacs (make_fixnum (-1)); + Fkill_emacs (make_fixnum (-1), Qnil); } else { @@ -1122,7 +1122,7 @@ command_loop (void) /* End of file in -batch run causes exit here. */ if (noninteractive) - Fkill_emacs (Qt); + Fkill_emacs (Qt, Qnil); } } @@ -1331,7 +1331,7 @@ command_loop_1 (void) Lisp_Object cmd; if (! FRAME_LIVE_P (XFRAME (selected_frame))) - Fkill_emacs (Qnil); + Fkill_emacs (Qnil, Qnil); /* Make sure the current window's buffer is selected. */ set_buffer_internal (XBUFFER (XWINDOW (selected_window)->contents)); @@ -1402,7 +1402,7 @@ command_loop_1 (void) /* A filter may have run while we were reading the input. */ if (! FRAME_LIVE_P (XFRAME (selected_frame))) - Fkill_emacs (Qnil); + Fkill_emacs (Qnil, Qnil); set_buffer_internal (XBUFFER (XWINDOW (selected_window)->contents)); ++num_input_keys; @@ -1660,7 +1660,7 @@ read_menu_command (void) unbind_to (count, Qnil); if (! FRAME_LIVE_P (XFRAME (selected_frame))) - Fkill_emacs (Qnil); + Fkill_emacs (Qnil, Qnil); if (i == 0 || i == -1) return Qt; @@ -2259,7 +2259,7 @@ read_event_from_main_queue (struct timespec *end_time, /* Terminate Emacs in batch mode if at eof. */ if (noninteractive && FIXNUMP (c) && XFIXNUM (c) < 0) - Fkill_emacs (make_fixnum (1)); + Fkill_emacs (make_fixnum (1), Qnil); if (FIXNUMP (c)) { @@ -4633,6 +4633,8 @@ timer_check (void) Lisp_Object tem = Vinhibit_quit; Vinhibit_quit = Qt; + block_input (); + turn_on_atimers (false); /* We use copies of the timers' lists to allow a timer to add itself again, without locking up Emacs if the newly added timer is @@ -4646,6 +4648,8 @@ timer_check (void) else idle_timers = Qnil; + turn_on_atimers (true); + unblock_input (); Vinhibit_quit = tem; do @@ -10039,7 +10043,7 @@ read_key_sequence (Lisp_Object *keybuf, Lisp_Object prompt, if (fix_current_buffer) { if (! FRAME_LIVE_P (XFRAME (selected_frame))) - Fkill_emacs (Qnil); + Fkill_emacs (Qnil, Qnil); if (XBUFFER (XWINDOW (selected_window)->contents) != current_buffer) Fset_buffer (XWINDOW (selected_window)->contents); @@ -10163,7 +10167,7 @@ read_key_sequence (Lisp_Object *keybuf, Lisp_Object prompt, record_unwind_current_buffer (); if (! FRAME_LIVE_P (XFRAME (selected_frame))) - Fkill_emacs (Qnil); + Fkill_emacs (Qnil, Qnil); set_buffer_internal (XBUFFER (XWINDOW (window)->contents)); goto replay_sequence; } @@ -11393,7 +11397,7 @@ quit_throw_to_read_char (bool from_signal) /* When not called from a signal handler it is safe to call Lisp. */ if (!from_signal && EQ (Vquit_flag, Qkill_emacs)) - Fkill_emacs (Qnil); + Fkill_emacs (Qnil, Qnil); /* Prevent another signal from doing this before we finish. */ clear_waiting_for_input (); @@ -12430,7 +12434,10 @@ Polling is automatically disabled in all other cases. */); doc: /* Maximum time between mouse clicks to make a double-click. Measured in milliseconds. The value nil means disable double-click recognition; t means double-clicks have no time limit and are detected -by position only. */); +by position only. + +In Lisp, you might want to use `mouse-double-click-time' instead of +reading the value of this variable directly. */); Vdouble_click_time = make_fixnum (500); DEFVAR_INT ("double-click-fuzz", double_click_fuzz, diff --git a/src/keymap.c b/src/keymap.c index 83c54e26300..da0a52bd2c1 100644 --- a/src/keymap.c +++ b/src/keymap.c @@ -2867,7 +2867,7 @@ You type Translation\n\ CALLN (Ffuncall, Qdescribe_map_tree, Vkey_translation_map, Qnil, Qnil, prefix, - msg, nomenu, Qt, Qnil, Qnil); + msg, nomenu, Qt, Qnil, Qnil, buffer); } /* Print the (major mode) local map. */ @@ -2881,7 +2881,7 @@ You type Translation\n\ CALLN (Ffuncall, Qdescribe_map_tree, start1, Qt, shadow, prefix, - msg, nomenu, Qnil, Qnil, Qnil); + msg, nomenu, Qnil, Qnil, Qnil, buffer); shadow = Fcons (start1, shadow); start1 = Qnil; } @@ -2894,7 +2894,7 @@ You type Translation\n\ CALLN (Ffuncall, Qdescribe_map_tree, start1, Qt, shadow, prefix, - msg, nomenu, Qnil, Qnil, Qnil); + msg, nomenu, Qnil, Qnil, Qnil, buffer); shadow = Fcons (start1, shadow); } else @@ -2917,7 +2917,7 @@ You type Translation\n\ CALLN (Ffuncall, Qdescribe_map_tree, start1, Qt, shadow, prefix, - msg, nomenu, Qnil, Qnil, Qnil); + msg, nomenu, Qnil, Qnil, Qnil, buffer); shadow = Fcons (start1, shadow); } @@ -2950,7 +2950,7 @@ You type Translation\n\ CALLN (Ffuncall, Qdescribe_map_tree, maps[i], Qt, shadow, prefix, - msg, nomenu, Qnil, Qnil, Qnil); + msg, nomenu, Qnil, Qnil, Qnil, buffer); shadow = Fcons (maps[i], shadow); SAFE_FREE (); } @@ -2968,7 +2968,7 @@ You type Translation\n\ CALLN (Ffuncall, Qdescribe_map_tree, start1, Qt, shadow, prefix, - msg, nomenu, Qnil, Qnil, Qnil); + msg, nomenu, Qnil, Qnil, Qnil, buffer); } else { @@ -2976,7 +2976,7 @@ You type Translation\n\ CALLN (Ffuncall, Qdescribe_map_tree, start1, Qt, shadow, prefix, - msg, nomenu, Qnil, Qnil, Qnil); + msg, nomenu, Qnil, Qnil, Qnil, buffer); } shadow = Fcons (start1, shadow); @@ -2987,7 +2987,7 @@ You type Translation\n\ CALLN (Ffuncall, Qdescribe_map_tree, current_global_map, Qt, shadow, prefix, - msg, nomenu, Qnil, Qt, Qnil); + msg, nomenu, Qnil, Qt, Qnil, buffer); /* Print the function-key-map translations under this prefix. */ if (!NILP (KVAR (current_kboard, Vlocal_function_key_map))) @@ -2996,7 +2996,7 @@ You type Translation\n\ CALLN (Ffuncall, Qdescribe_map_tree, KVAR (current_kboard, Vlocal_function_key_map), Qnil, Qnil, prefix, - msg, nomenu, Qt, Qnil, Qnil); + msg, nomenu, Qt, Qnil, Qnil, buffer); } /* Print the input-decode-map translations under this prefix. */ @@ -3006,7 +3006,7 @@ You type Translation\n\ CALLN (Ffuncall, Qdescribe_map_tree, KVAR (current_kboard, Vinput_decode_map), Qnil, Qnil, prefix, - msg, nomenu, Qt, Qnil, Qnil); + msg, nomenu, Qt, Qnil, Qnil, buffer); } return Qnil; } diff --git a/src/lisp.h b/src/lisp.h index f723876634a..1ad89fc4689 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -342,6 +342,7 @@ typedef EMACS_INT Lisp_Word; # define lisp_h_XIL(i) (i) # define lisp_h_XLP(o) ((void *) (uintptr_t) (o)) # endif +# define lisp_h_Qnil 0 #else # if LISP_WORDS_ARE_POINTERS # define lisp_h_XLI(o) ((EMACS_INT) (o).i) @@ -352,6 +353,7 @@ typedef EMACS_INT Lisp_Word; # define lisp_h_XIL(i) ((Lisp_Object) {i}) # define lisp_h_XLP(o) ((void *) (uintptr_t) (o).i) # endif +# define lisp_h_Qnil {0} #endif #define lisp_h_PSEUDOVECTORP(a,code) \ @@ -2151,9 +2153,9 @@ struct Lisp_Subr short min_args, max_args; const char *symbol_name; union { - const char *intspec; - Lisp_Object native_intspec; - }; + const char *string; + Lisp_Object native; + } intspec; Lisp_Object command_modes; EMACS_INT doc; #ifdef HAVE_NATIVE_COMP @@ -2183,6 +2185,16 @@ XSUBR (Lisp_Object a) return &XUNTAG (a, Lisp_Vectorlike, union Aligned_Lisp_Subr)->s; } +/* Return whether a value might be a valid docstring. + Used to distinguish the presence of non-docstring in the docstring slot, + as in the case of OClosures. */ +INLINE bool +VALID_DOCSTRING_P (Lisp_Object doc) +{ + return FIXNUMP (doc) || STRINGP (doc) + || (CONSP (doc) && STRINGP (XCAR (doc)) && FIXNUMP (XCDR (doc))); +} + enum char_table_specials { /* This is the number of slots that every char table must have. This @@ -3173,12 +3185,12 @@ CHECK_SUBR (Lisp_Object x) /* This version of DEFUN declares a function prototype with the right arguments, so we can catch errors with maxargs at compile-time. */ -#define DEFUN(lname, fnname, sname, minargs, maxargs, intspec, doc) \ - SUBR_SECTION_ATTRIBUTE \ - static union Aligned_Lisp_Subr sname = \ - {{{ PVEC_SUBR << PSEUDOVECTOR_AREA_BITS }, \ - { .a ## maxargs = fnname }, \ - minargs, maxargs, lname, {intspec}, 0}}; \ +#define DEFUN(lname, fnname, sname, minargs, maxargs, intspec, doc) \ + SUBR_SECTION_ATTRIBUTE \ + static union Aligned_Lisp_Subr sname = \ + {{{ PVEC_SUBR << PSEUDOVECTOR_AREA_BITS }, \ + { .a ## maxargs = fnname }, \ + minargs, maxargs, lname, {intspec}, lisp_h_Qnil}}; \ Lisp_Object fnname /* defsubr (Sname); diff --git a/src/macfont.m b/src/macfont.m index 34e48afb98f..4dd55e77469 100644 --- a/src/macfont.m +++ b/src/macfont.m @@ -57,8 +57,10 @@ static CFStringRef mac_font_create_preferred_family_for_attributes (CFDictionary static CFIndex mac_font_shape (CTFontRef, CFStringRef, struct mac_glyph_layout *, CFIndex, enum lgstring_direction); +#if MAC_OS_X_VERSION_MIN_REQUIRED < 1090 static CFArrayRef mac_font_copy_default_descriptors_for_language (CFStringRef); static CFStringRef mac_font_copy_default_name_for_charset_and_languages (CFCharacterSetRef, CFArrayRef); +#endif #if USE_CT_GLYPH_INFO static CGGlyph mac_ctfont_get_glyph_for_cid (CTFontRef, CTCharacterCollection, CGFontIndex); @@ -845,7 +847,7 @@ macfont_store_descriptor_attributes (CTFontDescriptorRef desc, {{FONT_WEIGHT_INDEX, kCTFontWeightTrait, {{-0.4, 50}, /* light */ {-0.24, 87.5}, /* (semi-light + normal) / 2 */ - {0, 100}, /* normal */ + {0, 80}, /* normal */ {0.24, 140}, /* (semi-bold + normal) / 2 */ {0.4, 200}, /* bold */ {CGFLOAT_MAX, CGFLOAT_MAX}}, @@ -3570,18 +3572,17 @@ mac_font_create_preferred_family_for_attributes (CFDictionaryRef attributes) if (languages && CFArrayGetCount (languages) > 0) { - if ([[NSProcessInfo processInfo] - isOperatingSystemAtLeastVersion: - ((NSOperatingSystemVersion){ - .majorVersion = 10, .minorVersion = 9})]) - values[num_values++] = CFArrayGetValueAtIndex (languages, 0); - else +#if MAC_OS_X_VERSION_MIN_REQUIRED < 1090 + if (CTGetCoreTextVersion () < kCTVersionNumber10_9) { CFCharacterSetRef charset = CFDictionaryGetValue (attributes, kCTFontCharacterSetAttribute); result = mac_font_copy_default_name_for_charset_and_languages (charset, languages); } + else +#endif + values[num_values++] = CFArrayGetValueAtIndex (languages, 0); } if (result == NULL) { @@ -4000,6 +4001,7 @@ mac_ctfont_get_glyph_for_cid (CTFontRef font, CTCharacterCollection collection, } #endif +#if MAC_OS_X_VERSION_MIN_REQUIRED < 1090 static CFArrayRef mac_font_copy_default_descriptors_for_language (CFStringRef language) { @@ -4134,6 +4136,7 @@ mac_font_copy_default_name_for_charset_and_languages (CFCharacterSetRef charset, return result; } +#endif void * macfont_get_nsctfont (struct font *font) diff --git a/src/minibuf.c b/src/minibuf.c index 97a6ec69011..df82bcb121a 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -34,6 +34,10 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include "systty.h" #include "pdumper.h" +#ifdef HAVE_NTGUI +#include "w32term.h" +#endif + /* List of buffers for use as minibuffers. The first element of the list is used for the outermost minibuffer invocation, the next element is used for a recursive minibuffer @@ -916,7 +920,17 @@ read_minibuf (Lisp_Object map, Lisp_Object initial, Lisp_Object prompt, XWINDOW (minibuf_window)->cursor.x = 0; XWINDOW (minibuf_window)->must_be_updated_p = true; update_frame (XFRAME (selected_frame), true, true); +#ifndef HAVE_NTGUI flush_frame (XFRAME (XWINDOW (minibuf_window)->frame)); +#else + /* The reason this function isn't `flush_display' in the RIF is + that `flush_frame' is also called in many other circumstances + when some code wants X requests to be sent to the X server, + but there is no corresponding "flush" concept on MS Windows, + and flipping buffers every time `flush_frame' is called + causes flicker. */ + w32_flip_buffers_if_dirty (XFRAME (XWINDOW (minibuf_window)->frame)); +#endif } /* Make minibuffer contents into a string. */ @@ -1568,36 +1582,47 @@ match_regexps (Lisp_Object string, Lisp_Object regexps, } DEFUN ("try-completion", Ftry_completion, Stry_completion, 2, 3, 0, - doc: /* Return common substring of all completions of STRING in COLLECTION. + doc: /* Return longest common substring of all completions of STRING in COLLECTION. + Test each possible completion specified by COLLECTION to see if it begins with STRING. The possible completions may be strings or symbols. Symbols are converted to strings before testing, -see `symbol-name'. -All that match STRING are compared together; the longest initial sequence -common to all these matches is the return value. -If there is no match at all, the return value is nil. -For a unique match which is exact, the return value is t. +by using `symbol-name'. + +If no possible completions match, the function returns nil; if +there's just one exact match, it returns t; otherwise it returns +the longest initial substring common to all possible completions +that begin with STRING. If COLLECTION is an alist, the keys (cars of elements) are the possible completions. If an element is not a cons cell, then the -element itself is the possible completion. -If COLLECTION is a hash-table, all the keys that are strings or symbols -are the possible completions. +element itself is a possible completion. +If COLLECTION is a hash-table, all the keys that are either strings +or symbols are the possible completions. If COLLECTION is an obarray, the names of all symbols in the obarray are the possible completions. COLLECTION can also be a function to do the completion itself. -It receives three arguments: the values STRING, PREDICATE and nil. +It receives three arguments: STRING, PREDICATE and nil. Whatever it returns becomes the value of `try-completion'. -If optional third argument PREDICATE is non-nil, -it is used to test each possible match. -The match is a candidate only if PREDICATE returns non-nil. -The argument given to PREDICATE is the alist element -or the symbol from the obarray. If COLLECTION is a hash-table, -predicate is called with two arguments: the key and the value. -Additionally to this predicate, `completion-regexp-list' -is used to further constrain the set of candidates. */) +If optional third argument PREDICATE is non-nil, it must be a function +of one or two arguments, and is used to test each possible completion. +A possible completion is accepted only if PREDICATE returns non-nil. + +The argument given to PREDICATE is either a string or a cons cell (whose +car is a string) from the alist, or a symbol from the obarray. +If COLLECTION is a hash-table, PREDICATE is called with two arguments: +the string key and the associated value. + +To be acceptable, a possible completion must also match all the regexps +in `completion-regexp-list' (unless COLLECTION is a function, in +which case that function should itself handle `completion-regexp-list'). + +If `completion-ignore-case' is non-nil, possible completions are matched +while ignoring letter-case, but no guarantee is made about the letter-case +of the return value, except that it comes either from the user's input +or from one of the possible completions. */) (Lisp_Object string, Lisp_Object collection, Lisp_Object predicate) { @@ -1807,11 +1832,13 @@ is used to further constrain the set of candidates. */) } DEFUN ("all-completions", Fall_completions, Sall_completions, 2, 4, 0, - doc: /* Search for partial matches to STRING in COLLECTION. -Test each of the possible completions specified by COLLECTION + doc: /* Search for partial matches of STRING in COLLECTION. + +Test each possible completion specified by COLLECTION to see if it begins with STRING. The possible completions may be strings or symbols. Symbols are converted to strings before testing, -see `symbol-name'. +by using `symbol-name'. + The value is a list of all the possible completions that match STRING. If COLLECTION is an alist, the keys (cars of elements) are the @@ -1823,17 +1850,21 @@ If COLLECTION is an obarray, the names of all symbols in the obarray are the possible completions. COLLECTION can also be a function to do the completion itself. -It receives three arguments: the values STRING, PREDICATE and t. +It receives three arguments: STRING, PREDICATE and t. Whatever it returns becomes the value of `all-completions'. -If optional third argument PREDICATE is non-nil, -it is used to test each possible match. -The match is a candidate only if PREDICATE returns non-nil. -The argument given to PREDICATE is the alist element -or the symbol from the obarray. If COLLECTION is a hash-table, -predicate is called with two arguments: the key and the value. -Additionally to this predicate, `completion-regexp-list' -is used to further constrain the set of candidates. +If optional third argument PREDICATE is non-nil, it must be a function +of one or two arguments, and is used to test each possible completion. +A possible completion is accepted only if PREDICATE returns non-nil. + +The argument given to PREDICATE is either a string or a cons cell (whose +car is a string) from the alist, or a symbol from the obarray. +If COLLECTION is a hash-table, PREDICATE is called with two arguments: +the string key and the associated value. + +To be acceptable, a possible completion must also match all the regexps +in `completion-regexp-list' (unless COLLECTION is a function, in +which case that function should itself handle `completion-regexp-list'). An obsolete optional fourth argument HIDE-SPACES is still accepted for backward compatibility. If non-nil, strings in COLLECTION that start diff --git a/src/msdos.h b/src/msdos.h index 7e57c7c1102..24697bcf24b 100644 --- a/src/msdos.h +++ b/src/msdos.h @@ -22,6 +22,10 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <dpmi.h> #include "termhooks.h" /* struct terminal */ +struct terminal; + +extern unsigned int _dos_commit(int); +#define tcdrain(f) _dos_commit(f) int dos_ttraw (struct tty_display_info *); int dos_ttcooked (void); @@ -57,6 +61,11 @@ ssize_t readlinkat (int, const char *, char *, size_t); int fstatat (int, char const *, struct stat *, int); int unsetenv (const char *); int faccessat (int, const char *, int, int); +int openat (int, const char *, int, int); +int fchmodat (int, const char *, mode_t, int); +int futimens (int, const struct timespec[2]); +int utimensat (int, const char *, const struct timespec[2], int); + void msdos_fatal_signal (int); void syms_of_msdos (void); int pthread_sigmask (int, const sigset_t *, sigset_t *); diff --git a/src/nsfns.m b/src/nsfns.m index 720ed3f88e5..a67dafe0950 100644 --- a/src/nsfns.m +++ b/src/nsfns.m @@ -891,7 +891,10 @@ static Lisp_Object ns_appkit_version_str (void) { NSString *tmp; + Lisp_Object string; + NSAutoreleasePool *autorelease; + autorelease = [[NSAutoreleasePool alloc] init]; #ifdef NS_IMPL_GNUSTEP tmp = [NSString stringWithFormat:@"gnustep-gui-%s", Xstr(GNUSTEP_GUI_VERSION)]; #elif defined (NS_IMPL_COCOA) @@ -901,7 +904,10 @@ ns_appkit_version_str (void) #else tmp = [NSString initWithUTF8String:@"ns-unknown"]; #endif - return [tmp lispString]; + string = [tmp lispString]; + [autorelease release]; + + return string; } @@ -1587,26 +1593,22 @@ Some window managers may refuse to restack windows. */) } } -DEFUN ("ns-popup-font-panel", Fns_popup_font_panel, Sns_popup_font_panel, - 0, 1, "", - doc: /* Pop up the font panel. */) - (Lisp_Object frame) +DEFUN ("x-select-font", Fx_select_font, Sx_select_font, 0, 2, 0, + doc: /* Read a font using a Nextstep dialog. +Return a font specification describing the selected font. + +FRAME is the frame on which to pop up the font chooser. If omitted or +nil, it defaults to the selected frame. */) + (Lisp_Object frame, Lisp_Object ignored) { struct frame *f = decode_window_system_frame (frame); - id fm = [NSFontManager sharedFontManager]; - struct font *font = f->output_data.ns->font; - NSFont *nsfont; -#ifdef NS_IMPL_GNUSTEP - nsfont = ((struct nsfont_info *)font)->nsfont; -#endif -#ifdef NS_IMPL_COCOA - nsfont = (NSFont *) macfont_get_nsctfont (font); -#endif - [fm setSelectedFont: nsfont isMultiple: NO]; - [fm orderFrontFontPanel: NSApp]; - return Qnil; -} + Lisp_Object font = [FRAME_NS_VIEW (f) showFontPanel]; + + if (NILP (font)) + quit (); + return font; +} DEFUN ("ns-popup-color-panel", Fns_popup_color_panel, Sns_popup_color_panel, 0, 1, "", @@ -1675,16 +1677,18 @@ Optional arg DIR_ONLY_P, if non-nil, means choose only directories. */) BOOL isSave = NILP (mustmatch) && NILP (dir_only_p); id panel; Lisp_Object fname = Qnil; - - NSString *promptS = NILP (prompt) || !STRINGP (prompt) ? nil : - [NSString stringWithLispString:prompt]; - NSString *dirS = NILP (dir) || !STRINGP (dir) ? - [NSString stringWithLispString:BVAR (current_buffer, directory)] : - [NSString stringWithLispString:dir]; - NSString *initS = NILP (init) || !STRINGP (init) ? nil : - [NSString stringWithLispString:init]; + NSString *promptS, *dirS, *initS, *str; NSEvent *nxev; + promptS = (NILP (prompt) || !STRINGP (prompt) + ? nil : [NSString stringWithLispString: prompt]); + dirS = (NILP (dir) || !STRINGP (dir) + ? [NSString stringWithLispString: + ENCODE_FILE (BVAR (current_buffer, directory))] : + [NSString stringWithLispString: ENCODE_FILE (dir)]); + initS = (NILP (init) || !STRINGP (init) + ? nil : [NSString stringWithLispString: init]); + check_window_system (NULL); if (fileDelegate == nil) @@ -1756,9 +1760,15 @@ Optional arg DIR_ONLY_P, if non-nil, means choose only directories. */) if (ns_fd_data.ret == MODAL_OK_RESPONSE) { - NSString *str = ns_filename_from_panel (panel); - if (! str) str = ns_directory_from_panel (panel); - if (str) fname = [str lispString]; + str = ns_filename_from_panel (panel); + + if (!str) + str = ns_directory_from_panel (panel); + if (str) + fname = [str lispString]; + + if (!NILP (fname)) + fname = DECODE_FILE (fname); } [[FRAME_NS_VIEW (SELECTED_FRAME ()) window] makeKeyWindow]; @@ -2103,6 +2113,7 @@ The optional argument FRAME is currently ignored. */) Lisp_Object list = Qnil; NSEnumerator *colorlists; NSColorList *clist; + NSAutoreleasePool *pool; if (!NILP (frame)) { @@ -2112,7 +2123,9 @@ The optional argument FRAME is currently ignored. */) } block_input (); - + /* This can be called during dumping, so we need to set up a + temporary autorelease pool. */ + pool = [[NSAutoreleasePool alloc] init]; colorlists = [[NSColorList availableColorLists] objectEnumerator]; while ((clist = [colorlists nextObject])) { @@ -2123,12 +2136,9 @@ The optional argument FRAME is currently ignored. */) NSString *cname; while ((cname = [cnames nextObject])) list = Fcons ([cname lispString], list); -/* for (i = [[clist allKeys] count] - 1; i >= 0; i--) - list = Fcons (build_string ([[[clist allKeys] objectAtIndex: i] - UTF8String]), list); */ } } - + [pool release]; unblock_input (); return list; @@ -2856,9 +2866,8 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0, str = SSDATA (string); f = decode_window_system_frame (frame); if (NILP (timeout)) - timeout = make_fixnum (5); - else - CHECK_FIXNAT (timeout); + timeout = Vx_show_tooltip_timeout; + CHECK_FIXNAT (timeout); if (NILP (dx)) dx = make_fixnum (5); @@ -3294,7 +3303,7 @@ Default is t. */); defsubr (&Sns_emacs_info_panel); defsubr (&Sns_list_services); defsubr (&Sns_perform_service); - defsubr (&Sns_popup_font_panel); + defsubr (&Sx_select_font); defsubr (&Sns_popup_color_panel); defsubr (&Sx_show_tip); diff --git a/src/nsfont.m b/src/nsfont.m index f3c8a82930b..e913a50cb69 100644 --- a/src/nsfont.m +++ b/src/nsfont.m @@ -1176,15 +1176,15 @@ nsfont_draw (struct glyph_string *s, int from, int to, int x, int y, face = s->face; - r.origin.x = s->x; + r.origin.x = x; if (s->face->box != FACE_NO_BOX && s->first_glyph->left_box_line_p) r.origin.x += max (s->face->box_vertical_line_width, 0); - r.origin.y = s->y; + r.origin.y = y; r.size.height = FONT_HEIGHT (font); - for (int i = from; i < to; ++i) - c[i] = s->char2b[i]; + for (int i = 0; i < len; ++i) + c[i] = s->char2b[i + from]; /* Fill background if requested. */ if (with_background && !isComposite) @@ -1210,8 +1210,6 @@ nsfont_draw (struct glyph_string *s, int from, int to, int x, int y, } /* set up for character rendering */ - r.origin.y = y; - if (s->hl == DRAW_CURSOR) col = FRAME_BACKGROUND_COLOR (s->f); else @@ -1721,8 +1719,8 @@ ns_glyph_metrics (struct nsfont_info *font_info, unsigned int block) metrics->rbearing = lrint (rb); metrics->lbearing = lrint (lb); - metrics->descent = NSMinY (r); - metrics->ascent = NSMaxY (r); + metrics->descent = - NSMaxY (r); + metrics->ascent = - NSMinY (r); } unblock_input (); } diff --git a/src/nsmenu.m b/src/nsmenu.m index 81d7cd2da13..b0ab12bb87d 100644 --- a/src/nsmenu.m +++ b/src/nsmenu.m @@ -649,7 +649,8 @@ prettify_key (const char *key) work around it by using tabs to split the title into two columns. */ NSFont *menuFont = [NSFont menuFontOfSize:0]; - NSDictionary *font_attribs = @{NSFontAttributeName: menuFont}; + NSDictionary *font_attribs = [NSDictionary dictionaryWithObjectsAndKeys: + menuFont, NSFontAttributeName, nil]; CGFloat maxNameWidth = 0; CGFloat maxKeyWidth = 0; @@ -677,11 +678,12 @@ prettify_key (const char *key) NSTextTab *tab = [[[NSTextTab alloc] initWithTextAlignment: NSTextAlignmentRight location: maxWidth - options: @{}] autorelease]; + options: [NSDictionary dictionary]] autorelease]; NSMutableParagraphStyle *pstyle = [[[NSMutableParagraphStyle alloc] init] autorelease]; - [pstyle setTabStops: @[tab]]; - attributes = @{NSParagraphStyleAttributeName: pstyle}; + [pstyle setTabStops: [NSArray arrayWithObject:tab]]; + attributes = [NSDictionary dictionaryWithObjectsAndKeys: + pstyle, NSParagraphStyleAttributeName, nil]; #endif /* clear existing contents */ @@ -758,12 +760,6 @@ prettify_key (const char *key) : Qnil; } -#ifdef NS_IMPL_GNUSTEP -/* The code below doesn't work on Mac OS X, because it runs a nested - Carbon-related event loop to track menu bar movement. - - But it works fine aside from that, so it will work on GNUstep if - they start to call `willHighlightItem'. */ - (void) menu: (NSMenu *) menu willHighlightItem: (NSMenuItem *) item { NSInteger idx = [item tag]; @@ -777,12 +773,11 @@ prettify_key (const char *key) XSETFRAME (frame, f); help = AREF (vec, idx + MENU_ITEMS_ITEM_HELP); + popup_activated_flag++; if (STRINGP (help) || NILP (help)) - kbd_buffer_store_help_event (frame, help); - - raise (SIGIO); + show_help_echo (help, Qnil, Qnil, Qnil); + popup_activated_flag--; } -#endif #ifdef NS_IMPL_GNUSTEP - (void) close diff --git a/src/nsterm.h b/src/nsterm.h index 4cba5c0be8f..9d8a6f486fc 100644 --- a/src/nsterm.h +++ b/src/nsterm.h @@ -442,23 +442,25 @@ typedef id instancetype; #else @interface EmacsView : NSView <NSTextInput> #endif - { +{ #ifdef NS_IMPL_COCOA - char *old_title; - BOOL maximizing_resize; + char *old_title; + BOOL maximizing_resize; #endif - BOOL windowClosing; - NSString *workingText; - BOOL processingCompose; - int fs_state, fs_before_fs, next_maximized; - int maximized_width, maximized_height; - EmacsWindow *nonfs_window; - BOOL fs_is_native; + BOOL font_panel_active; + NSFont *font_panel_result; + BOOL windowClosing; + NSString *workingText; + BOOL processingCompose; + int fs_state, fs_before_fs, next_maximized; + int maximized_width, maximized_height; + EmacsWindow *nonfs_window; + BOOL fs_is_native; @public - struct frame *emacsframe; - int scrollbarsNeedingUpdate; - NSRect ns_userRect; - } + struct frame *emacsframe; + int scrollbarsNeedingUpdate; + NSRect ns_userRect; +} /* AppKit-side interface */ - (instancetype)menuDown: (id)sender; @@ -485,6 +487,7 @@ typedef id instancetype; #ifdef NS_IMPL_GNUSTEP - (void)windowDidMove: (id)sender; #endif +- (Lisp_Object) showFontPanel; - (int)fullscreenState; #if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MIN_REQUIRED >= 101400 @@ -1290,6 +1293,7 @@ extern char gnustep_base_version[]; /* version tracking */ #define NSAlertStyleCritical NSCriticalAlertStyle #define NSControlSizeRegular NSRegularControlSize #define NSCompositingOperationCopy NSCompositeCopy +#define NSTextAlignmentRight NSRightTextAlignment /* And adds NSWindowStyleMask. */ #ifdef __OBJC__ diff --git a/src/nsterm.m b/src/nsterm.m index 550f29212e9..fef7f0dc6c8 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -163,7 +163,7 @@ char const * nstrace_fullscreen_type_name (int fs_type) && NSAppKitVersionNumber >= NSAppKitVersionNumber10_7) return [self colorUsingColorSpace: [NSColorSpace sRGBColorSpace]]; #endif - return [self colorUsingColorSpace: [NSColorSpace deviceRGBColorSpace]]; + return [self colorUsingColorSpace: [NSColorSpace genericRGBColorSpace]]; } + (NSColor *)colorWithUnsignedLong:(unsigned long)c @@ -751,7 +751,18 @@ ns_parent_window_rect (struct frame *f) EmacsView *parentView = FRAME_NS_VIEW (FRAME_PARENT_FRAME (f)); parentRect = [parentView convertRect:[parentView frame] toView:nil]; + +#if defined (NS_IMPL_COCOA) && !defined (MAC_OS_X_VERSION_10_7) + parentRect.origin = [[parentView window] convertBaseToScreen:parentRect.origin]; +#elif defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MIN_REQUIRED < 1070 + if ([[parentView window] + respondsToSelector:@selector(convertRectToScreen:)]) + parentRect = [[parentView window] convertRectToScreen:parentRect]; + else + parentRect.origin = [[parentView window] convertBaseToScreen:parentRect.origin]; +#else parentRect = [[parentView window] convertRectToScreen:parentRect]; +#endif } else parentRect = [[[NSScreen screens] objectAtIndex:0] frame]; @@ -788,10 +799,16 @@ ns_row_rect (struct window *w, struct glyph_row *row, double ns_frame_scale_factor (struct frame *f) { -#if defined (NS_IMPL_COCOA) && MAC_OS_X_VERSION_MAX_ALLOWED > 1060 - return [[FRAME_NS_VIEW (f) window] backingScaleFactor]; -#else +#if defined (NS_IMPL_GNUSTEP) || !defined (MAC_OS_X_VERSION_10_7) return [[FRAME_NS_VIEW (f) window] userSpaceScaleFactor]; +#elif MAC_OS_X_VERSION_MIN_REQUIRED < 1070 + if ([[FRAME_NS_VIEW (f) window] + respondsToSelector:@selector(backingScaleFactor:)]) + return [[FRAME_NS_VIEW (f) window] backingScaleFactor]; + else + return [[FRAME_NS_VIEW (f) window] userSpaceScaleFactor]; +#else + return [[FRAME_NS_VIEW (f) window] backingScaleFactor]; #endif } @@ -3945,6 +3962,81 @@ ns_draw_composite_glyph_string_foreground (struct glyph_string *s) } } +/* Draw the foreground of glyph string S for glyphless characters. */ +static void +ns_draw_glyphless_glyph_string_foreground (struct glyph_string *s) +{ + struct glyph *glyph = s->first_glyph; + NSGlyph char2b[8]; + int x, i, j; + + /* If first glyph of S has a left box line, start drawing the text + of S to the right of that box line. */ + if (s->face && s->face->box != FACE_NO_BOX + && s->first_glyph->left_box_line_p) + x = s->x + max (s->face->box_vertical_line_width, 0); + else + x = s->x; + + s->char2b = char2b; + + for (i = 0; i < s->nchars; i++, glyph++) + { + char buf[7]; + char *str = NULL; + int len = glyph->u.glyphless.len; + + if (glyph->u.glyphless.method == GLYPHLESS_DISPLAY_ACRONYM) + { + if (len > 0 + && CHAR_TABLE_P (Vglyphless_char_display) + && (CHAR_TABLE_EXTRA_SLOTS (XCHAR_TABLE (Vglyphless_char_display)) + >= 1)) + { + Lisp_Object acronym + = (! glyph->u.glyphless.for_no_font + ? CHAR_TABLE_REF (Vglyphless_char_display, + glyph->u.glyphless.ch) + : XCHAR_TABLE (Vglyphless_char_display)->extras[0]); + if (STRINGP (acronym)) + str = SSDATA (acronym); + } + } + else if (glyph->u.glyphless.method == GLYPHLESS_DISPLAY_HEX_CODE) + { + unsigned int ch = glyph->u.glyphless.ch; + eassume (ch <= MAX_CHAR); + sprintf (buf, "%0*X", ch < 0x10000 ? 4 : 6, ch); + str = buf; + } + + if (str) + { + int upper_len = (len + 1) / 2; + + /* It is assured that all LEN characters in STR is ASCII. */ + for (j = 0; j < len; j++) + char2b[j] = s->font->driver->encode_char (s->font, str[j]) & 0xFFFF; + s->font->driver->draw (s, 0, upper_len, + x + glyph->slice.glyphless.upper_xoff, + s->ybase + glyph->slice.glyphless.upper_yoff, + false); + s->font->driver->draw (s, upper_len, len, + x + glyph->slice.glyphless.lower_xoff, + s->ybase + glyph->slice.glyphless.lower_yoff, + false); + } + if (glyph->u.glyphless.method != GLYPHLESS_DISPLAY_THIN_SPACE) + ns_draw_box (NSMakeRect (x, s->ybase - glyph->ascent, + glyph->pixel_width - 1, + glyph->ascent + glyph->descent - 1), + 1, 1, + [NSColor colorWithUnsignedLong:NS_FACE_FOREGROUND (s->face)], + YES, YES); + x += glyph->pixel_width; + } +} + static void ns_draw_glyph_string (struct glyph_string *s) /* -------------------------------------------------------------------------- @@ -4058,9 +4150,7 @@ ns_draw_glyph_string (struct glyph_string *s) else ns_maybe_dumpglyphs_background (s, s->first_glyph->type == COMPOSITE_GLYPH); - /* ... */ - /* Not yet implemented. */ - /* ... */ + ns_draw_glyphless_glyph_string_foreground (s); break; default: @@ -4352,10 +4442,10 @@ ns_read_socket (struct terminal *terminal, struct input_event *hold_quit) } -int -ns_select (int nfds, fd_set *readfds, fd_set *writefds, - fd_set *exceptfds, struct timespec *timeout, - sigset_t *sigmask) +static int +ns_select_1 (int nfds, fd_set *readfds, fd_set *writefds, + fd_set *exceptfds, struct timespec *timeout, + sigset_t *sigmask, BOOL run_loop_only) /* -------------------------------------------------------------------------- Replacement for select, checking for events -------------------------------------------------------------------------- */ @@ -4371,7 +4461,7 @@ ns_select (int nfds, fd_set *readfds, fd_set *writefds, check_native_fs (); #endif - if (hold_event_q.nr > 0) + if (hold_event_q.nr > 0 && !run_loop_only) { /* We already have events pending. */ raise (SIGIO); @@ -4389,12 +4479,12 @@ ns_select (int nfds, fd_set *readfds, fd_set *writefds, if (NSApp == nil || ![NSThread isMainThread] || (timeout && timeout->tv_sec == 0 && timeout->tv_nsec == 0)) - return thread_select(pselect, nfds, readfds, writefds, - exceptfds, timeout, sigmask); + return thread_select (pselect, nfds, readfds, writefds, + exceptfds, timeout, sigmask); else { struct timespec t = {0, 0}; - thread_select(pselect, 0, NULL, NULL, NULL, &t, sigmask); + thread_select (pselect, 0, NULL, NULL, NULL, &t, sigmask); } /* FIXME: This draining of outerpool causes a crash when a buffer @@ -4512,6 +4602,15 @@ ns_select (int nfds, fd_set *readfds, fd_set *writefds, return result; } +int +ns_select (int nfds, fd_set *readfds, fd_set *writefds, + fd_set *exceptfds, struct timespec *timeout, + sigset_t *sigmask) +{ + return ns_select_1 (nfds, readfds, writefds, exceptfds, + timeout, sigmask, NO); +} + #ifdef HAVE_PTHREAD void ns_run_loop_break (void) @@ -5331,20 +5430,21 @@ ns_term_init (Lisp_Object display_name) void ns_term_shutdown (int sig) { + NSAutoreleasePool *pool; + /* We also need an autorelease pool here, since this can be called + during dumping. */ + pool = [[NSAutoreleasePool alloc] init]; [[NSUserDefaults standardUserDefaults] synchronize]; + [pool release]; /* code not reached in emacs.c after this is called by shut_down_emacs: */ if (STRINGP (Vauto_save_list_file_name)) unlink (SSDATA (Vauto_save_list_file_name)); if (sig == 0 || sig == SIGTERM) - { - [NSApp terminate: NSApp]; - } - else // force a stack trace to happen - { - emacs_abort (); - } + [NSApp terminate: NSApp]; + else /* Force a stack trace to happen. */ + emacs_abort (); } @@ -5955,6 +6055,123 @@ not_in_argv (NSString *arg) @end /* EmacsApp */ +static Lisp_Object +ns_font_desc_to_font_spec (NSFontDescriptor *desc, NSFont *font) +{ + NSFontSymbolicTraits traits = [desc symbolicTraits]; + NSDictionary *dict = [desc objectForKey: NSFontTraitsAttribute]; + NSString *family = [font familyName]; + Lisp_Object lwidth, lslant, lweight, lheight; + NSNumber *tem; + + lwidth = Qnil; + lslant = Qnil; + lweight = Qnil; + lheight = Qnil; + + if (traits & NSFontBoldTrait) + lweight = Qbold; + + if (traits & NSFontItalicTrait) + lslant = Qitalic; + + if (traits & NSFontCondensedTrait) + lwidth = Qcondensed; + else if (traits & NSFontExpandedTrait) + lwidth = Qexpanded; + + if (dict != nil) + { + tem = [dict objectForKey: NSFontSlantTrait]; + + if (tem != nil) + lslant = ([tem floatValue] > 0 + ? Qitalic : ([tem floatValue] < 0 + ? Qreverse_italic + : Qnormal)); + + tem = [dict objectForKey: NSFontWeightTrait]; + +#ifdef NS_IMPL_GNUSTEP + if (tem != nil) + lweight = ([tem floatValue] > 0 + ? Qbold : ([tem floatValue] < -0.4f + ? Qlight : Qnormal)); +#else + if (tem != nil) + { + if ([tem floatValue] >= 0.4) + lweight = Qbold; + else if ([tem floatValue] >= 0.24) + lweight = Qmedium; + else if ([tem floatValue] >= 0) + lweight = Qnormal; + else if ([tem floatValue] >= -0.24) + lweight = Qsemi_light; + else + lweight = Qlight; + } +#endif + + tem = [dict objectForKey: NSFontWidthTrait]; + + if (tem != nil) + lwidth = ([tem floatValue] > 0 + ? Qexpanded : ([tem floatValue] < 0 + ? Qcondensed : Qnormal)); + } + + lheight = make_float ([font pointSize]); + + return CALLN (Ffont_spec, + QCwidth, lwidth, QCslant, lslant, + QCweight, lweight, QCsize, lheight, + QCfamily, (family + ? [family lispString] + : Qnil)); +} + +#ifdef NS_IMPL_COCOA +static NSView * +ns_create_font_panel_buttons (id target, SEL select, SEL cancel_action) +{ + NSMatrix *matrix; + NSButtonCell *prototype; + NSSize cell_size; + NSRect frame; + NSButtonCell *cancel, *ok; + + prototype = [[NSButtonCell alloc] init]; + [prototype setBezelStyle: NSBezelStyleRounded]; + [prototype setTitle: @"Cancel"]; + cell_size = [prototype cellSize]; + frame = NSMakeRect (0, 0, cell_size.width * 2, + cell_size.height); + matrix = [[NSMatrix alloc] initWithFrame: frame + mode: NSTrackModeMatrix + prototype: prototype + numberOfRows: 1 + numberOfColumns: 2]; + [prototype release]; + + ok = (NSButtonCell *) [matrix cellAtRow: 0 column: 0]; + cancel = (NSButtonCell *) [matrix cellAtRow: 0 column: 1]; + + [ok setTitle: @"OK"]; + [ok setTarget: target]; + [ok setAction: select]; + [ok setButtonType: NSButtonTypeMomentaryPushIn]; + + [cancel setTitle: @"Cancel"]; + [cancel setTarget: target]; + [cancel setAction: cancel_action]; + [cancel setButtonType: NSButtonTypeMomentaryPushIn]; + + [matrix selectCell: ok]; + + return matrix; +} +#endif /* ========================================================================== @@ -5991,40 +6208,129 @@ not_in_argv (NSString *arg) /* Called on font panel selection. */ -- (void)changeFont: (id)sender +- (void) changeFont: (id) sender { - struct face *face = FACE_FROM_ID (emacsframe, DEFAULT_FACE_ID); - struct font *font = face->font; - id newFont; - CGFloat size; + struct font *font = FRAME_OUTPUT_DATA (emacsframe)->font; NSFont *nsfont; - struct input_event ie; - - NSTRACE ("[EmacsView changeFont:]"); - EVENT_INIT (ie); #ifdef NS_IMPL_GNUSTEP - nsfont = ((struct nsfont_info *)font)->nsfont; -#endif -#ifdef NS_IMPL_COCOA + nsfont = ((struct nsfont_info *) font)->nsfont; +#else nsfont = (NSFont *) macfont_get_nsctfont (font); #endif - if ((newFont = [sender convertFont: nsfont])) - { - ie.kind = NS_NONKEY_EVENT; - ie.modifiers = 0; - ie.code = KEY_NS_CHANGE_FONT; - XSETFRAME (ie.frame_or_window, emacsframe); + if (!font_panel_active) + return; + + if (font_panel_result) + [font_panel_result release]; + + font_panel_result = (NSFont *) [sender convertFont: nsfont]; - size = [newFont pointSize]; - ns_input_fontsize = make_fixnum (lrint (size)); - ns_input_font = [[newFont familyName] lispString]; + if (font_panel_result) + [font_panel_result retain]; - kbd_buffer_store_event (&ie); +#ifndef NS_IMPL_COCOA + font_panel_active = NO; + [NSApp stop: self]; +#endif +} + +#ifdef NS_IMPL_COCOA +- (void) noteUserSelectedFont +{ + font_panel_active = NO; + + /* If no font was previously selected, use the currently selected + font. */ + + if (!font_panel_result && FRAME_FONT (emacsframe)) + { + font_panel_result + = macfont_get_nsctfont (FRAME_FONT (emacsframe)); + + if (font_panel_result) + [font_panel_result retain]; } + + [NSApp stop: self]; } +- (void) noteUserCancelledSelection +{ + font_panel_active = NO; + + if (font_panel_result) + [font_panel_result release]; + font_panel_result = nil; + + [NSApp stop: self]; +} +#endif + +- (Lisp_Object) showFontPanel +{ + id fm = [NSFontManager sharedFontManager]; + struct font *font = FRAME_OUTPUT_DATA (emacsframe)->font; + NSFont *nsfont, *result; + struct timespec timeout; +#ifdef NS_IMPL_COCOA + NSView *buttons; + BOOL canceled; +#endif + +#ifdef NS_IMPL_GNUSTEP + nsfont = ((struct nsfont_info *) font)->nsfont; +#else + nsfont = (NSFont *) macfont_get_nsctfont (font); +#endif + +#ifdef NS_IMPL_COCOA + buttons + = ns_create_font_panel_buttons (self, + @selector (noteUserSelectedFont), + @selector (noteUserCancelledSelection)); + [[fm fontPanel: YES] setAccessoryView: buttons]; + [buttons release]; +#endif + + [fm setSelectedFont: nsfont isMultiple: NO]; + [fm orderFrontFontPanel: NSApp]; + + font_panel_active = YES; + timeout = make_timespec (0, 100000000); + + block_input (); + while (font_panel_active +#ifdef NS_IMPL_COCOA + && (canceled = [[fm fontPanel: YES] isVisible]) +#else + && [[fm fontPanel: YES] isVisible] +#endif + ) + ns_select_1 (0, NULL, NULL, NULL, &timeout, NULL, YES); + unblock_input (); + + if (font_panel_result) + [font_panel_result autorelease]; + +#ifdef NS_IMPL_COCOA + if (!canceled) + font_panel_result = nil; +#endif + + result = font_panel_result; + font_panel_result = nil; + + [[fm fontPanel: YES] setIsVisible: NO]; + font_panel_active = NO; + + if (result) + return ns_font_desc_to_font_spec ([result fontDescriptor], + result); + + return Qnil; +} - (BOOL)acceptsFirstResponder { @@ -6032,7 +6338,6 @@ not_in_argv (NSString *arg) return YES; } - - (void)resetCursorRects { NSRect visible = [self visibleRect]; @@ -6869,7 +7174,7 @@ not_in_argv (NSString *arg) [self mouseMoved: e]; } -#ifdef NS_IMPL_COCOA +#if defined NS_IMPL_COCOA && defined MAC_OS_X_VERSION_10_7 - (void) magnifyWithEvent: (NSEvent *) event { NSPoint pt = [self convertPoint: [event locationInWindow] fromView: nil]; @@ -8452,7 +8757,7 @@ not_in_argv (NSString *arg) expected later. */ #if MAC_OS_X_VERSION_MIN_REQUIRED < 101000 - if ([child respondsToSelector:@selector(setAccessibilitySubrole:)]) + if ([self respondsToSelector:@selector(setAccessibilitySubrole:)]) #endif /* Set the accessibility subroles. */ if (parentFrame) @@ -8484,7 +8789,7 @@ not_in_argv (NSString *arg) #ifdef NS_IMPL_COCOA #if MAC_OS_X_VERSION_MIN_REQUIRED < 1070 - if ([ourView respondsToSelector:@selector (toggleFullScreen)] + if ([ourView respondsToSelector:@selector (toggleFullScreen)]) #endif /* If we are the descendent of a fullscreen window and we have no new parent, go fullscreen. */ @@ -8509,11 +8814,11 @@ not_in_argv (NSString *arg) #ifdef NS_IMPL_COCOA #if MAC_OS_X_VERSION_MIN_REQUIRED < 1070 - if ([ourView respondsToSelector:@selector (toggleFullScreen)] + if ([ourView respondsToSelector:@selector (toggleFullScreen)]) #endif - /* Child frames must not be fullscreen. */ - if ([ourView fsIsNative] && [ourView isFullscreen]) - [ourView toggleFullScreen:self]; + /* Child frames must not be fullscreen. */ + if ([ourView fsIsNative] && [ourView isFullscreen]) + [ourView toggleFullScreen:self]; #endif [parentWindow addChildWindow:self @@ -10072,6 +10377,9 @@ This variable is ignored on macOS < 10.7 and GNUstep. Default is t. */); DEFSYM (QCordinary, ":ordinary"); DEFSYM (QCfunction, ":function"); DEFSYM (QCmouse, ":mouse"); + DEFSYM (Qcondensed, "condensed"); + DEFSYM (Qreverse_italic, "reverse-italic"); + DEFSYM (Qexpanded, "expanded"); #ifdef NS_IMPL_COCOA Fprovide (Qcocoa, Qnil); diff --git a/src/pdumper.c b/src/pdumper.c index 24393e03665..5923d9b1d82 100644 --- a/src/pdumper.c +++ b/src/pdumper.c @@ -2853,7 +2853,7 @@ dump_bool_vector (struct dump_context *ctx, const struct Lisp_Vector *v) static dump_off dump_subr (struct dump_context *ctx, const struct Lisp_Subr *subr) { -#if CHECK_STRUCTS && !defined (HASH_Lisp_Subr_A212A8F82A) +#if CHECK_STRUCTS && !defined (HASH_Lisp_Subr_20B7443AD7) # error "Lisp_Subr changed. See CHECK_STRUCTS comment in config.h." #endif struct Lisp_Subr out; @@ -2876,13 +2876,13 @@ dump_subr (struct dump_context *ctx, const struct Lisp_Subr *subr) dump_remember_cold_op (ctx, COLD_OP_NATIVE_SUBR, make_lisp_ptr ((void *) subr, Lisp_Vectorlike)); - dump_field_lv (ctx, &out, subr, &subr->native_intspec, WEIGHT_NORMAL); + dump_field_lv (ctx, &out, subr, &subr->intspec.native, WEIGHT_NORMAL); dump_field_lv (ctx, &out, subr, &subr->command_modes, WEIGHT_NORMAL); } else { dump_field_emacs_ptr (ctx, &out, subr, &subr->symbol_name); - dump_field_emacs_ptr (ctx, &out, subr, &subr->intspec); + dump_field_emacs_ptr (ctx, &out, subr, &subr->intspec.string); dump_field_emacs_ptr (ctx, &out, subr, &subr->command_modes); } DUMP_FIELD_COPY (&out, subr, doc); diff --git a/src/pgtkfns.c b/src/pgtkfns.c index e6ce5e2f443..a0fcf70f31b 100644 --- a/src/pgtkfns.c +++ b/src/pgtkfns.c @@ -177,7 +177,7 @@ pgtk_display_info_for_name (Lisp_Object name) static void -x_set_foreground_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +pgtk_set_foreground_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) { unsigned long fg, old_fg; @@ -204,7 +204,7 @@ x_set_foreground_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) static void -x_set_background_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +pgtk_set_background_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) { unsigned long bg; @@ -246,7 +246,7 @@ pgtk_set_alpha_background (struct frame *f, Lisp_Object arg, Lisp_Object oldval) } static void -x_set_border_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +pgtk_set_border_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) { int pix; @@ -257,7 +257,7 @@ x_set_border_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) } static void -x_set_cursor_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +pgtk_set_cursor_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) { unsigned long fore_pixel, pixel; struct pgtk_output *x = f->output_data.pgtk; @@ -360,7 +360,8 @@ pgtk_set_name (struct frame *f, Lisp_Object name, int explicit) specified a name for the frame; the name will override any set by the redisplay code. */ static void -x_explicitly_set_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +pgtk_explicitly_set_name (struct frame *f, Lisp_Object arg, + Lisp_Object oldval) { pgtk_set_name (f, arg, true); } @@ -381,7 +382,7 @@ pgtk_implicitly_set_name (struct frame *f, Lisp_Object arg, If NAME is nil, use the frame name as the title. */ static void -x_set_title (struct frame *f, Lisp_Object name, Lisp_Object old_name) +pgtk_set_title (struct frame *f, Lisp_Object name, Lisp_Object old_name) { /* Don't change the title if it's already NAME. */ if (EQ (name, f->title)) @@ -407,7 +408,7 @@ pgtk_set_doc_edited (void) static void -x_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) +pgtk_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) { int nlines; /* Right now, menu bars don't work properly in minibuf-only frames; @@ -453,7 +454,7 @@ x_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) The frame's height doesn't change. */ static void -x_set_tab_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) +pgtk_set_tab_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) { int nlines; @@ -467,13 +468,12 @@ x_set_tab_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) else nlines = 0; - x_change_tab_bar_height (f, nlines * FRAME_LINE_HEIGHT (f)); + pgtk_change_tab_bar_height (f, nlines * FRAME_LINE_HEIGHT (f)); } - /* Set the pixel height of the tab bar of frame F to HEIGHT. */ void -x_change_tab_bar_height (struct frame *f, int height) +pgtk_change_tab_bar_height (struct frame *f, int height) { int unit = FRAME_LINE_HEIGHT (f); int old_height = FRAME_TAB_BAR_HEIGHT (f); @@ -545,7 +545,7 @@ x_change_tool_bar_height (struct frame *f, int height) /* Toolbar support. */ static void -x_set_tool_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) +pgtk_set_tool_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) { int nlines; @@ -564,7 +564,7 @@ x_set_tool_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) } static void -x_set_child_frame_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +pgtk_set_child_frame_border_width (struct frame *f, Lisp_Object arg, Lisp_Object oldval) { int border = check_int_nonnegative (arg); @@ -578,12 +578,11 @@ x_set_child_frame_border_width (struct frame *f, Lisp_Object arg, Lisp_Object ol pgtk_clear_under_internal_border (f); } } - } static void -x_set_internal_border_width (struct frame *f, Lisp_Object arg, - Lisp_Object oldval) +pgtk_set_internal_border_width (struct frame *f, Lisp_Object arg, + Lisp_Object oldval) { int border = check_int_nonnegative (arg); @@ -600,7 +599,7 @@ x_set_internal_border_width (struct frame *f, Lisp_Object arg, } static void -x_set_icon_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +pgtk_set_icon_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval) { bool result; @@ -630,7 +629,7 @@ x_set_icon_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval) } static void -x_set_icon_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +pgtk_set_icon_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval) { bool result; @@ -661,34 +660,19 @@ x_set_icon_name (struct frame *f, Lisp_Object arg, Lisp_Object oldval) unblock_input (); } -/* This is the same as the xfns.c definition. */ static void -x_set_cursor_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +pgtk_set_cursor_type (struct frame *f, Lisp_Object arg, Lisp_Object oldval) { set_frame_cursor_types (f, arg); } -/* called to set mouse pointer color, but all other terms use it to - initialize pointer types (and don't set the color ;) */ static void -x_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) -{ -} - -/** - * x_set_undecorated: - * - * Set frame F's `undecorated' parameter. If non-nil, F's window-system - * window is drawn without decorations, title, minimize/maximize boxes - * and external borders. This usually means that the window cannot be - * dragged, resized, iconified, maximized or deleted with the mouse. If - * nil, draw the frame with all the elements listed above unless these - * have been suspended via window manager settings. - * - * Some window managers may not honor this parameter. - */ +pgtk_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) +{ +} + static void -x_set_undecorated (struct frame *f, Lisp_Object new_value, +pgtk_set_undecorated (struct frame *f, Lisp_Object new_value, Lisp_Object old_value) { if (!EQ (new_value, old_value)) @@ -698,18 +682,8 @@ x_set_undecorated (struct frame *f, Lisp_Object new_value, } } -/** - * x_set_skip_taskbar: - * - * Set frame F's `skip-taskbar' parameter. If non-nil, this should - * remove F's icon from the taskbar associated with the display of F's - * window-system window and inhibit switching to F's window via - * <Alt>-<TAB>. If nil, lift these restrictions. - * - * Some window managers may not honor this parameter. - */ static void -x_set_skip_taskbar (struct frame *f, Lisp_Object new_value, +pgtk_set_skip_taskbar (struct frame *f, Lisp_Object new_value, Lisp_Object old_value) { if (!EQ (new_value, old_value)) @@ -719,18 +693,9 @@ x_set_skip_taskbar (struct frame *f, Lisp_Object new_value, } } -/** - * x_set_override_redirect: - * - * Set frame F's `override_redirect' parameter which, if non-nil, hints - * that the window manager doesn't want to deal with F. Usually, such - * frames have no decorations and always appear on top of all frames. - * - * Some window managers may not honor this parameter. - */ static void -x_set_override_redirect (struct frame *f, Lisp_Object new_value, - Lisp_Object old_value) +pgtk_set_override_redirect (struct frame *f, Lisp_Object new_value, + Lisp_Object old_value) { if (!EQ (new_value, old_value)) { @@ -745,9 +710,7 @@ x_set_override_redirect (struct frame *f, Lisp_Object new_value, } } -/* Set icon from FILE for frame F. By using GTK functions the icon - may be any format that GdkPixbuf knows about, i.e. not just bitmaps. */ - +/* Set icon from FILE for frame F. */ bool xg_set_icon (struct frame *f, Lisp_Object file) { @@ -969,59 +932,58 @@ unless TYPE is `png'. */) return pgtk_cr_export_frames (frames, surface_type); } - -/* Note: see frame.c for template, also where generic functions are impl */ -frame_parm_handler pgtk_frame_parm_handlers[] = { - gui_set_autoraise, /* generic OK */ - gui_set_autolower, /* generic OK */ - x_set_background_color, - x_set_border_color, - gui_set_border_width, - x_set_cursor_color, - x_set_cursor_type, - gui_set_font, /* generic OK */ - x_set_foreground_color, - x_set_icon_name, - x_set_icon_type, - x_set_child_frame_border_width, - x_set_internal_border_width, /* generic OK */ - gui_set_right_divider_width, - gui_set_bottom_divider_width, - x_set_menu_bar_lines, - x_set_mouse_color, - x_explicitly_set_name, - gui_set_scroll_bar_width, /* generic OK */ - gui_set_scroll_bar_height, /* generic OK */ - x_set_title, - gui_set_unsplittable, /* generic OK */ - gui_set_vertical_scroll_bars, /* generic OK */ - gui_set_horizontal_scroll_bars, /* generic OK */ - gui_set_visibility, /* generic OK */ - x_set_tab_bar_lines, - x_set_tool_bar_lines, - pgtk_set_scroll_bar_foreground, - pgtk_set_scroll_bar_background, - gui_set_screen_gamma, /* generic OK */ - gui_set_line_spacing, /* generic OK, sets f->extra_line_spacing to int */ - gui_set_left_fringe, /* generic OK */ - gui_set_right_fringe, /* generic OK */ - 0, /* x_set_wait_for_wm */ - gui_set_fullscreen, /* generic OK */ - gui_set_font_backend, /* generic OK */ - gui_set_alpha, - pgtk_set_sticky, - pgtk_set_tool_bar_position, - 0, /* x_set_inhibit_double_buffering */ - x_set_undecorated, - x_set_parent_frame, - x_set_skip_taskbar, - x_set_no_focus_on_map, - x_set_no_accept_focus, - x_set_z_group, - x_set_override_redirect, - gui_set_no_special_glyphs, - pgtk_set_alpha_background, -}; +frame_parm_handler pgtk_frame_parm_handlers[] = + { + gui_set_autoraise, /* generic OK */ + gui_set_autolower, /* generic OK */ + pgtk_set_background_color, + pgtk_set_border_color, + gui_set_border_width, + pgtk_set_cursor_color, + pgtk_set_cursor_type, + gui_set_font, /* generic OK */ + pgtk_set_foreground_color, + pgtk_set_icon_name, + pgtk_set_icon_type, + pgtk_set_child_frame_border_width, + pgtk_set_internal_border_width, /* generic OK */ + gui_set_right_divider_width, + gui_set_bottom_divider_width, + pgtk_set_menu_bar_lines, + pgtk_set_mouse_color, + pgtk_explicitly_set_name, + gui_set_scroll_bar_width, /* generic OK */ + gui_set_scroll_bar_height, /* generic OK */ + pgtk_set_title, + gui_set_unsplittable, /* generic OK */ + gui_set_vertical_scroll_bars, /* generic OK */ + gui_set_horizontal_scroll_bars, /* generic OK */ + gui_set_visibility, /* generic OK */ + pgtk_set_tab_bar_lines, + pgtk_set_tool_bar_lines, + pgtk_set_scroll_bar_foreground, + pgtk_set_scroll_bar_background, + gui_set_screen_gamma, /* generic OK */ + gui_set_line_spacing, /* generic OK, sets f->extra_line_spacing to int */ + gui_set_left_fringe, /* generic OK */ + gui_set_right_fringe, /* generic OK */ + 0, + gui_set_fullscreen, /* generic OK */ + gui_set_font_backend, /* generic OK */ + gui_set_alpha, + pgtk_set_sticky, + pgtk_set_tool_bar_position, + 0, + pgtk_set_undecorated, + pgtk_set_parent_frame, + pgtk_set_skip_taskbar, + pgtk_set_no_focus_on_map, + pgtk_set_no_accept_focus, + pgtk_set_z_group, + pgtk_set_override_redirect, + gui_set_no_special_glyphs, + pgtk_set_alpha_background, + }; /* Handler for signals raised during x_create_frame and @@ -1053,7 +1015,7 @@ unwind_create_frame (Lisp_Object frame) && FRAME_IMAGE_CACHE (f)->refcount == image_cache_refcount) FRAME_IMAGE_CACHE (f)->refcount++; - x_free_frame_resources (f); + pgtk_free_frame_resources (f); free_glyphs (f); return Qt; } @@ -1186,7 +1148,7 @@ incorrect when you specify fractional scale factor in compositor. If you set scale factor by this function, it is used instead of Gdk's one. Pass nil as SCALE-FACTOR if you want to reset the specified monitor's -scale factor. */ ) +scale factor. */) (Lisp_Object monitor_model, Lisp_Object scale_factor) { CHECK_STRING (monitor_model); @@ -1514,10 +1476,11 @@ This function is an internal primitive--use `make-frame' instead. */ ) init_frame_faces (f); /* We have to call adjust_frame_size here since otherwise - x_set_tool_bar_lines will already work with the character sizes - installed by init_frame_faces while the frame's pixel size is still - calculated from a character size of 1 and we subsequently hit the - (height >= 0) assertion in window_box_height. + pgtk_set_tool_bar_lines will already work with the character + sizes installed by init_frame_faces while the frame's pixel size + is still calculated from a character size of 1 and we + subsequently hit the (height >= 0) assertion in + window_box_height. The non-pixelwise code apparently worked around this because it had one frame line vs one toolbar line which left us with a zero @@ -1525,14 +1488,12 @@ This function is an internal primitive--use `make-frame' instead. */ ) Also process `min-width' and `min-height' parameters right here because `frame-windows-min-size' needs them. */ - tem = - gui_display_get_arg (dpyinfo, parms, Qmin_width, NULL, NULL, - RES_TYPE_NUMBER); + tem = gui_display_get_arg (dpyinfo, parms, Qmin_width, NULL, NULL, + RES_TYPE_NUMBER); if (NUMBERP (tem)) store_frame_param (f, Qmin_width, tem); - tem = - gui_display_get_arg (dpyinfo, parms, Qmin_height, NULL, NULL, - RES_TYPE_NUMBER); + tem = gui_display_get_arg (dpyinfo, parms, Qmin_height, NULL, NULL, + RES_TYPE_NUMBER); if (NUMBERP (tem)) store_frame_param (f, Qmin_height, tem); adjust_frame_size (f, FRAME_COLS (f) * FRAME_COLUMN_WIDTH (f), @@ -1693,7 +1654,7 @@ This function is an internal primitive--use `make-frame' instead. */ ) badly we want them. This should be done after we have the menu bar so that its size can be taken into account. */ block_input (); - x_wm_set_size_hint (f, window_prompting, false); + xg_wm_set_size_hint (f, window_prompting, false); unblock_input (); adjust_frame_size (f, FRAME_TEXT_WIDTH (f), FRAME_TEXT_HEIGHT (f), @@ -2256,27 +2217,6 @@ DEFUN ("x-display-list", Fx_display_list, Sx_display_list, 0, 0, 0, return result; } - -DEFUN ("pgtk-hide-others", Fpgtk_hide_others, Spgtk_hide_others, 0, 0, 0, - doc: /* Hides all applications other than Emacs. */) - (void) -{ - check_window_system (NULL); - return Qnil; -} - -DEFUN ("pgtk-hide-emacs", Fpgtk_hide_emacs, Spgtk_hide_emacs, 1, 1, 0, - doc: /* If ON is non-nil, the entire Emacs application is hidden. -Otherwise if Emacs is hidden, it is unhidden. -If ON is equal to `activate', Emacs is unhidden and becomes -the active application. */) - (Lisp_Object on) -{ - check_window_system (NULL); - return Qnil; -} - - DEFUN ("pgtk-font-name", Fpgtk_font_name, Spgtk_font_name, 1, 1, 0, doc: /* Determine font PostScript or family name for font NAME. NAME should be a string containing either the font name or an XLFD @@ -2312,7 +2252,6 @@ check_x_display_info (Lisp_Object frame) return check_pgtk_display_info (frame); } - void pgtk_set_scroll_bar_default_width (struct frame *f) { @@ -2360,9 +2299,8 @@ pgtk_get_string_resource (XrmDatabase rdb, const char *name, return res; } - Lisp_Object -x_get_focus_frame (struct frame *frame) +pgtk_get_focus_frame (struct frame *frame) { struct pgtk_display_info *dpyinfo = FRAME_DISPLAY_INFO (frame); Lisp_Object focus; @@ -2374,13 +2312,6 @@ x_get_focus_frame (struct frame *frame) return focus; } -/* ========================================================================== - - Lisp definitions that, for whatever reason, we can't alias as 'ns-XXX'. - - ========================================================================== */ - - DEFUN ("xw-color-defined-p", Fxw_color_defined_p, Sxw_color_defined_p, 1, 2, 0, doc: /* Internal function called by `color-defined-p', which see. */) (Lisp_Object color, Lisp_Object frame) @@ -2412,7 +2343,6 @@ DEFUN ("xw-color-values", Fxw_color_values, Sxw_color_values, 1, 2, 0, return Qnil; } - DEFUN ("xw-display-color-p", Fxw_display_color_p, Sxw_display_color_p, 0, 1, 0, doc: /* Internal function called by `display-color-p', which see. */) (Lisp_Object terminal) @@ -2421,7 +2351,6 @@ DEFUN ("xw-display-color-p", Fxw_display_color_p, Sxw_display_color_p, 0, 1, 0, return Qt; } - DEFUN ("x-display-grayscale-p", Fx_display_grayscale_p, Sx_display_grayscale_p, 0, 1, 0, doc: /* Return t if the display supports shades of gray. Note that color displays do support shades of gray. @@ -2433,7 +2362,6 @@ If omitted or nil, that stands for the selected frame's display. */) return Qnil; } - DEFUN ("x-display-pixel-width", Fx_display_pixel_width, Sx_display_pixel_width, 0, 1, 0, doc: /* Return the width in pixels of the display TERMINAL. The optional argument TERMINAL specifies which display to ask about. @@ -2479,7 +2407,6 @@ each physical monitor, use `display-monitor-attributes-list'. */) return make_fixnum (width); } - DEFUN ("x-display-pixel-height", Fx_display_pixel_height, Sx_display_pixel_height, 0, 1, 0, doc: /* Return the height in pixels of the display TERMINAL. The optional argument TERMINAL specifies which display to ask about. @@ -3034,8 +2961,8 @@ compute_tip_xy (struct frame *f, Lisp_Object parms, Lisp_Object dx, { min_x = 0; min_y = 0; - max_x = x_display_pixel_width (FRAME_DISPLAY_INFO (f)); - max_y = x_display_pixel_height (FRAME_DISPLAY_INFO (f)); + max_x = pgtk_display_pixel_width (FRAME_DISPLAY_INFO (f)); + max_y = pgtk_display_pixel_height (FRAME_DISPLAY_INFO (f)); } if (INTEGERP (top)) @@ -3074,7 +3001,7 @@ compute_tip_xy (struct frame *f, Lisp_Object parms, Lisp_Object dx, /* Hide tooltip. Delete its frame if DELETE is true. */ static Lisp_Object -x_hide_tip (bool delete) +pgtk_hide_tip (bool delete) { if (!NILP (tip_timer)) { @@ -3165,7 +3092,8 @@ PARMS is an optional list of frame parameters which can be used to change the tooltip's appearance. Automatically hide the tooltip after TIMEOUT seconds. TIMEOUT nil -means use the default timeout of 5 seconds. +means use the default timeout from the `x-show-tooltip-timeout' +variable. If the list of frame parameters PARMS contains a `left' parameter, display the tooltip at that x-position. If the list of frame parameters @@ -3211,9 +3139,8 @@ Text larger than the specified size is clipped. */) return unbind_to (count, Qnil); if (NILP (timeout)) - timeout = make_fixnum (5); - else - CHECK_FIXNAT (timeout); + timeout = Vx_show_tooltip_timeout; + CHECK_FIXNAT (timeout); if (NILP (dx)) dx = make_fixnum (5); @@ -3314,13 +3241,13 @@ Text larger than the specified size is clipped. */) } } - x_hide_tip (delete); + pgtk_hide_tip (delete); } else - x_hide_tip (true); + pgtk_hide_tip (true); } else - x_hide_tip (true); + pgtk_hide_tip (true); tip_last_frame = frame; tip_last_string = string; @@ -3447,7 +3374,7 @@ DEFUN ("x-hide-tip", Fx_hide_tip, Sx_hide_tip, 0, 0, 0, Value is t if tooltip was open, nil otherwise. */) (void) { - return x_hide_tip (!tooltip_reuse_hidden_frame); + return pgtk_hide_tip (!tooltip_reuse_hidden_frame); } /* Return geometric attributes of FRAME. According to the value of @@ -3473,10 +3400,8 @@ frame_geometry (Lisp_Object frame, Lisp_Object attribute) int left_pos, top_pos; if (FRAME_GTK_OUTER_WIDGET (f)) - { - gtk_window_get_position (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)), - &left_pos, &top_pos); - } + gtk_window_get_position (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)), + &left_pos, &top_pos); else { GtkAllocation alloc; @@ -3864,9 +3789,8 @@ nil, it defaults to the selected frame. */) return unbind_to (count, font); } -#if GTK_CHECK_VERSION (3, 14, 0) DEFUN ("x-gtk-debug", Fx_gtk_debug, Sx_gtk_debug, 1, 1, 0, - doc: /* Toggle interactive GTK debugging. */) + doc: /* SKIP: real doc in xfns.c. */) (Lisp_Object enable) { gboolean enable_debug = !NILP (enable); @@ -3877,13 +3801,6 @@ DEFUN ("x-gtk-debug", Fx_gtk_debug, Sx_gtk_debug, 1, 1, 0, return NILP (enable) ? Qnil : Qt; } -#endif /* GTK_CHECK_VERSION (3, 14, 0) */ - -/* ========================================================================== - - Lisp interface declaration - - ========================================================================== */ void syms_of_pgtkfns (void) @@ -3901,27 +3818,6 @@ syms_of_pgtkfns (void) doc: /* SKIP: real doc in xfns.c. */); Vx_cursor_fore_pixel = Qnil; - DEFVAR_LISP ("pgtk-icon-type-alist", Vpgtk_icon_type_alist, - doc: /* Alist of elements (REGEXP . IMAGE) for images of icons associated to frames. -If the title of a frame matches REGEXP, then IMAGE.tiff is -selected as the image of the icon representing the frame when it's -miniaturized. If an element is t, then Emacs tries to select an icon -based on the filetype of the visited file. - -The images have to be installed in a folder called English.lproj in the -Emacs folder. You have to restart Emacs after installing new icons. - -Example: Install an icon Gnus.tiff and execute the following code - -(setq pgtk-icon-type-alist -(append pgtk-icon-type-alist -\\='((\"^\\\\*\\\\(Group\\\\*$\\\\|Summary \\\\|Article\\\\*$\\\\)\" -. \"Gnus\")))) - -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); - Fprovide (intern_c_string ("gtk"), Qnil); DEFVAR_LISP ("gtk-version-string", Vgtk_version_string, @@ -3949,7 +3845,6 @@ be used as the image of the icon representing the frame. */); g_free (ver); } - defsubr (&Spgtk_set_resource); defsubr (&Sxw_display_color_p); /* this and next called directly by C code */ defsubr (&Sx_display_grayscale_p); @@ -3977,13 +3872,7 @@ be used as the image of the icon representing the frame. */); defsubr (&Sx_open_connection); defsubr (&Sx_close_connection); defsubr (&Sx_display_list); - -#if GTK_CHECK_VERSION (3, 14, 0) defsubr (&Sx_gtk_debug); -#endif - - defsubr (&Spgtk_hide_others); - defsubr (&Spgtk_hide_emacs); defsubr (&Sx_show_tip); defsubr (&Sx_hide_tip); diff --git a/src/pgtkmenu.c b/src/pgtkmenu.c index bd63af3b223..eec9f419d07 100644 --- a/src/pgtkmenu.c +++ b/src/pgtkmenu.c @@ -62,19 +62,14 @@ pgtk_menu_set_in_use (bool in_use) struct frame *f = XFRAME (frame); if (in_use && FRAME_Z_GROUP_ABOVE (f)) - x_set_z_group (f, Qabove_suspended, Qabove); + pgtk_set_z_group (f, Qabove_suspended, Qabove); else if (!in_use && FRAME_Z_GROUP_ABOVE_SUSPENDED (f)) - x_set_z_group (f, Qabove, Qabove_suspended); + pgtk_set_z_group (f, Qabove, Qabove_suspended); } } DEFUN ("x-menu-bar-open-internal", Fx_menu_bar_open_internal, Sx_menu_bar_open_internal, 0, 1, "i", - doc: /* Start key navigation of the menu bar in FRAME. - This initially opens the first menu bar item and you can then navigate with the - arrow keys, select a menu entry with the return key or cancel with the - escape key. If FRAME has no menu bar this function does nothing. - - If FRAME is nil or not given, use the selected frame. */) + doc: /* SKIP: real doc in USE_GTK definition in xmenu.c. */) (Lisp_Object frame) { GtkWidget *menubar; diff --git a/src/pgtkterm.c b/src/pgtkterm.c index 8b60064c421..c8c8bd0d85e 100644 --- a/src/pgtkterm.c +++ b/src/pgtkterm.c @@ -1,4 +1,4 @@ -/* Pure Gtk+-3 communication module. -*- coding: utf-8 -*- +/* Communication module for window systems using GTK. Copyright (C) 1989, 1993-1994, 2005-2006, 2008-2022 Free Software Foundation, Inc. @@ -68,11 +68,9 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <gdk/gdkwayland.h> #endif -#define STORE_KEYSYM_FOR_DEBUG(keysym) ((void)0) - -#define FRAME_CR_CONTEXT(f) ((f)->output_data.pgtk->cr_context) +#define FRAME_CR_CONTEXT(f) ((f)->output_data.pgtk->cr_context) #define FRAME_CR_ACTIVE_CONTEXT(f) ((f)->output_data.pgtk->cr_active) -#define FRAME_CR_SURFACE(f) (cairo_get_target (FRAME_CR_CONTEXT (f))) +#define FRAME_CR_SURFACE(f) (cairo_get_target (FRAME_CR_CONTEXT (f))) /* Non-zero means that a HELP_EVENT has been generated since Emacs start. */ @@ -280,8 +278,9 @@ flip_cr_context (struct frame *f) if (cr != FRAME_CR_CONTEXT (f)) { cairo_destroy (cr); - FRAME_CR_ACTIVE_CONTEXT (f) = cairo_reference (FRAME_CR_CONTEXT (f)); + FRAME_CR_ACTIVE_CONTEXT (f) + = cairo_reference (FRAME_CR_CONTEXT (f)); } unblock_input (); } @@ -412,7 +411,7 @@ pgtk_frame_raise_lower (struct frame *f, bool raise_flag) /* Free X resources of frame F. */ void -x_free_frame_resources (struct frame *f) +pgtk_free_frame_resources (struct frame *f) { struct pgtk_display_info *dpyinfo; Mouse_HLInfo *hlinfo; @@ -513,7 +512,7 @@ x_free_frame_resources (struct frame *f) } void -x_destroy_window (struct frame *f) +pgtk_destroy_window (struct frame *f) /* -------------------------------------------------------------------------- External: Delete the window -------------------------------------------------------------------------- */ @@ -522,7 +521,7 @@ x_destroy_window (struct frame *f) check_window_system (f); if (dpyinfo->gdpy != NULL) - x_free_frame_resources (f); + pgtk_free_frame_resources (f); dpyinfo->reference_count--; } @@ -531,7 +530,7 @@ x_destroy_window (struct frame *f) from its current recorded position values and gravity. */ static void -x_calc_absolute_position (struct frame *f) +pgtk_calc_absolute_position (struct frame *f) { int flags = f->size_hint_flags; struct frame *p = FRAME_PARENT_FRAME (f); @@ -565,7 +564,7 @@ x_calc_absolute_position (struct frame *f) f->left_pos = (FRAME_PIXEL_WIDTH (p) - width - 2 * f->border_width + f->left_pos); else - f->left_pos = (x_display_pixel_width (FRAME_DISPLAY_INFO (f)) + f->left_pos = (pgtk_display_pixel_width (FRAME_DISPLAY_INFO (f)) - width + f->left_pos); } @@ -591,7 +590,7 @@ x_calc_absolute_position (struct frame *f) f->top_pos = (FRAME_PIXEL_HEIGHT (p) - height - 2 * f->border_width + f->top_pos); else - f->top_pos = (x_display_pixel_height (FRAME_DISPLAY_INFO (f)) + f->top_pos = (pgtk_display_pixel_height (FRAME_DISPLAY_INFO (f)) - height + f->top_pos); } @@ -608,10 +607,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, int xoff, int yoff, int change_gravity) -/* -------------------------------------------------------------------------- - External: Position the window - -------------------------------------------------------------------------- */ +pgtk_set_offset (struct frame *f, int xoff, int yoff, int change_gravity) { if (change_gravity > 0) { @@ -625,18 +621,16 @@ x_set_offset (struct frame *f, int xoff, int yoff, int change_gravity) f->win_gravity = NorthWestGravity; } - x_calc_absolute_position (f); + pgtk_calc_absolute_position (f); block_input (); - x_wm_set_size_hint (f, 0, false); + xg_wm_set_size_hint (f, 0, false); if (change_gravity != 0) { if (FRAME_GTK_OUTER_WIDGET (f)) - { - gtk_window_move (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)), - 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); @@ -677,7 +671,7 @@ pgtk_set_window_size (struct frame *f, bool change_gravity, f->output_data.pgtk->preferred_width = pixelwidth; f->output_data.pgtk->preferred_height = pixelheight; - x_wm_set_size_hint (f, 0, 0); + xg_wm_set_size_hint (f, 0, 0); xg_frame_set_char_size (f, pixelwidth, pixelheight); gtk_widget_queue_resize (FRAME_WIDGET (f)); @@ -714,7 +708,7 @@ 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)) - x_set_offset (f, f->left_pos, f->top_pos, 0); + pgtk_set_offset (f, f->left_pos, f->top_pos, 0); SET_FRAME_ICONIFIED (f, true); SET_FRAME_VISIBLE (f, 0); @@ -723,8 +717,8 @@ pgtk_iconify_frame (struct frame *f) } static gboolean -pgtk_make_frame_visible_wait_for_map_event_cb (GtkWidget * widget, - GdkEventAny * event, +pgtk_make_frame_visible_wait_for_map_event_cb (GtkWidget *widget, + GdkEventAny *event, gpointer user_data) { int *foundptr = user_data; @@ -745,19 +739,19 @@ pgtk_wait_for_map_event (struct frame *f, bool multiple_times) { if (FLOATP (Vpgtk_wait_for_event_timeout)) { - guint msec = - (guint) (XFLOAT_DATA (Vpgtk_wait_for_event_timeout) * 1000); + guint msec + = (guint) (XFLOAT_DATA (Vpgtk_wait_for_event_timeout) * 1000); int found = 0; int timed_out = 0; - gulong id = - g_signal_connect (FRAME_WIDGET (f), "map-event", - G_CALLBACK - (pgtk_make_frame_visible_wait_for_map_event_cb), - &found); - guint src = - g_timeout_add (msec, - pgtk_make_frame_visible_wait_for_map_event_timeout, - &timed_out); + gulong id + = g_signal_connect (FRAME_WIDGET (f), "map-event", + G_CALLBACK + (pgtk_make_frame_visible_wait_for_map_event_cb), + &found); + guint src + = g_timeout_add (msec, + pgtk_make_frame_visible_wait_for_map_event_timeout, + &timed_out); if (!multiple_times) { @@ -771,6 +765,7 @@ pgtk_wait_for_map_event (struct frame *f, bool multiple_times) } g_signal_handler_disconnect (FRAME_WIDGET (f), id); + if (!timed_out) g_source_remove (src); } @@ -778,9 +773,6 @@ pgtk_wait_for_map_event (struct frame *f, bool multiple_times) void pgtk_make_frame_visible (struct frame *f) -/* -------------------------------------------------------------------------- - External: Show the window (X11 semantics) - -------------------------------------------------------------------------- */ { GtkWidget *win = FRAME_GTK_OUTER_WIDGET (f); @@ -797,17 +789,11 @@ pgtk_make_frame_visible (struct frame *f) void pgtk_make_frame_invisible (struct frame *f) -/* -------------------------------------------------------------------------- - External: Hide the window (X11 semantics) - -------------------------------------------------------------------------- */ { gtk_widget_hide (FRAME_WIDGET (f)); - /* Map events are emitted many times, and - * map_event() do SET_FRAME_VISIBLE(f, 1). - * I expect visible = 0, so process those map events here and - * SET_FRAME_VISIBLE(f, 0) after that. - */ + /* Handle any pending map event(s), then make the frame visible + manually, to avoid race conditions. */ pgtk_wait_for_map_event (f, true); SET_FRAME_VISIBLE (f, 0); @@ -886,45 +872,26 @@ pgtk_new_font (struct frame *f, Lisp_Object font_object, int fontset) } int -x_display_pixel_height (struct pgtk_display_info *dpyinfo) +pgtk_display_pixel_height (struct pgtk_display_info *dpyinfo) { GdkDisplay *gdpy = dpyinfo->gdpy; GdkScreen *gscr = gdk_display_get_default_screen (gdpy); + return gdk_screen_get_height (gscr); } int -x_display_pixel_width (struct pgtk_display_info *dpyinfo) +pgtk_display_pixel_width (struct pgtk_display_info *dpyinfo) { GdkDisplay *gdpy = dpyinfo->gdpy; GdkScreen *gscr = gdk_display_get_default_screen (gdpy); + return gdk_screen_get_width (gscr); } void -x_set_parent_frame (struct frame *f, Lisp_Object new_value, - Lisp_Object old_value) -/* -------------------------------------------------------------------------- - Set frame F's `parent-frame' parameter. If non-nil, make F a child - frame of the frame specified by that parameter. Technically, this - makes F's window-system window a child window of the parent frame's - window-system window. If nil, make F's window-system window a - top-level window--a child of its display's root window. - - A child frame's `left' and `top' parameters specify positions - relative to the top-left corner of its parent frame's native - rectangle. On macOS moving a parent frame moves all its child - frames too, keeping their position relative to the parent - unaltered. When a parent frame is iconified or made invisible, its - child frames are made invisible. When a parent frame is deleted, - its child frames are deleted too. - - Whether a child frame has a tool bar may be window-system or window - manager dependent. It's advisable to disable it via the frame - parameter settings. - - Some window managers may not honor this parameter. - -------------------------------------------------------------------------- */ +pgtk_set_parent_frame (struct frame *f, Lisp_Object new_value, + Lisp_Object old_value) { struct frame *p = NULL; @@ -964,7 +931,8 @@ x_set_parent_frame (struct frame *f, Lisp_Object new_value, { GtkWidget *whbox_of_f = gtk_widget_get_parent (fixed); - /* Here, unhighlight can be called and may change border_color_css_provider. */ + /* Here, unhighlight can be called and may change + border_color_css_provider. */ gtk_container_remove (GTK_CONTAINER (whbox_of_f), fixed); if (FRAME_GTK_OUTER_WIDGET (f)) @@ -985,10 +953,11 @@ x_set_parent_frame (struct frame *f, Lisp_Object new_value, { xg_create_frame_outer_widgets (f); pgtk_set_event_handler (f); - gtk_box_pack_start (GTK_BOX (f->output_data.pgtk->hbox_widget), fixed, TRUE, TRUE, 0); + gtk_box_pack_start (GTK_BOX (f->output_data.pgtk->hbox_widget), + fixed, TRUE, TRUE, 0); f->output_data.pgtk->preferred_width = alloc.width; f->output_data.pgtk->preferred_height = alloc.height; - x_wm_set_size_hint (f, 0, 0); + xg_wm_set_size_hint (f, 0, 0); xg_frame_set_char_size (f, FRAME_PIXEL_TO_TEXT_WIDTH (f, alloc.width), FRAME_PIXEL_TO_TEXT_HEIGHT (f, alloc.height)); gtk_widget_queue_resize (FRAME_WIDGET (f)); @@ -1025,20 +994,11 @@ x_set_parent_frame (struct frame *f, Lisp_Object new_value, } } - +/* Doesn't work on wayland. */ void -x_set_no_focus_on_map (struct frame *f, Lisp_Object new_value, - Lisp_Object old_value) -/* Set frame F's `no-focus-on-map' parameter which, if non-nil, means - * that F's window-system window does not want to receive input focus - * when it is mapped. (A frame's window is mapped when the frame is - * displayed for the first time and when the frame changes its state - * from `iconified' or `invisible' to `visible'.) - * - * Some window managers may not honor this parameter. */ +pgtk_set_no_focus_on_map (struct frame *f, Lisp_Object new_value, + Lisp_Object old_value) { - /* doesn't work on wayland. */ - if (!EQ (new_value, old_value)) { xg_set_no_focus_on_map (f, new_value); @@ -1047,36 +1007,16 @@ x_set_no_focus_on_map (struct frame *f, Lisp_Object new_value, } void -x_set_no_accept_focus (struct frame *f, Lisp_Object new_value, - Lisp_Object old_value) -/* Set frame F's `no-accept-focus' parameter which, if non-nil, hints - * that F's window-system window does not want to receive input focus - * via mouse clicks or by moving the mouse into it. - * - * If non-nil, this may have the unwanted side-effect that a user cannot - * scroll a non-selected frame with the mouse. - * - * Some window managers may not honor this parameter. */ +pgtk_set_no_accept_focus (struct frame *f, Lisp_Object new_value, + Lisp_Object old_value) { - /* doesn't work on wayland. */ - xg_set_no_accept_focus (f, new_value); FRAME_NO_ACCEPT_FOCUS (f) = !NILP (new_value); } void -x_set_z_group (struct frame *f, Lisp_Object new_value, Lisp_Object old_value) -/* Set frame F's `z-group' parameter. If `above', F's window-system - window is displayed above all windows that do not have the `above' - property set. If nil, F's window is shown below all windows that - have the `above' property set and above all windows that have the - `below' property set. If `below', F's window is displayed below - all windows that do. - - Some window managers may not honor this parameter. */ +pgtk_set_z_group (struct frame *f, Lisp_Object new_value, Lisp_Object old_value) { - /* doesn't work on wayland. */ - if (!FRAME_GTK_OUTER_WIDGET (f)) return; @@ -1137,7 +1077,7 @@ pgtk_initialize_display_info (struct pgtk_display_info *dpyinfo) face. */ static void -x_set_cursor_gc (struct glyph_string *s) +pgtk_set_cursor_gc (struct glyph_string *s) { if (s->font == FRAME_FONT (s->f) && s->face->background == FRAME_BACKGROUND_PIXEL (s->f) @@ -1175,7 +1115,7 @@ x_set_cursor_gc (struct glyph_string *s) /* Set up S->gc of glyph string S for drawing text in mouse face. */ static void -x_set_mouse_face_gc (struct glyph_string *s) +pgtk_set_mouse_face_gc (struct glyph_string *s) { prepare_face_for_display (s->f, s->face); @@ -1204,7 +1144,7 @@ x_set_mouse_face_gc (struct glyph_string *s) matrix was built, so there isn't much to do, here. */ static void -x_set_mode_line_face_gc (struct glyph_string *s) +pgtk_set_mode_line_face_gc (struct glyph_string *s) { s->xgcv.foreground = s->face->foreground; s->xgcv.background = s->face->background; @@ -1216,7 +1156,7 @@ x_set_mode_line_face_gc (struct glyph_string *s) pattern. */ static void -x_set_glyph_string_gc (struct glyph_string *s) +pgtk_set_glyph_string_gc (struct glyph_string *s) { prepare_face_for_display (s->f, s->face); @@ -1228,17 +1168,17 @@ x_set_glyph_string_gc (struct glyph_string *s) } else if (s->hl == DRAW_INVERSE_VIDEO) { - x_set_mode_line_face_gc (s); + pgtk_set_mode_line_face_gc (s); s->stippled_p = s->face->stipple != 0; } else if (s->hl == DRAW_CURSOR) { - x_set_cursor_gc (s); + pgtk_set_cursor_gc (s); s->stippled_p = false; } else if (s->hl == DRAW_MOUSE_FACE) { - x_set_mouse_face_gc (s); + pgtk_set_mouse_face_gc (s); s->stippled_p = s->face->stipple != 0; } else if (s->hl == DRAW_IMAGE_RAISED || s->hl == DRAW_IMAGE_SUNKEN) @@ -1256,7 +1196,7 @@ x_set_glyph_string_gc (struct glyph_string *s) line or menu if we don't have X toolkit support. */ static void -x_set_glyph_string_clipping (struct glyph_string *s, cairo_t * cr) +pgtk_set_glyph_string_clipping (struct glyph_string *s, cairo_t * cr) { XRectangle r[2]; int n = get_glyph_string_clip_rects (s, r, 2); @@ -1271,14 +1211,13 @@ x_set_glyph_string_clipping (struct glyph_string *s, cairo_t * cr) } } - /* Set SRC's clipping for output of glyph string DST. This is called when we are drawing DST's left_overhang or right_overhang only in the area of SRC. */ static void -x_set_glyph_string_clipping_exactly (struct glyph_string *src, - struct glyph_string *dst, cairo_t * cr) +pgtk_set_glyph_string_clipping_exactly (struct glyph_string *src, + struct glyph_string *dst, cairo_t * cr) { dst->clip[0].x = src->x; dst->clip[0].y = src->y; @@ -1290,7 +1229,6 @@ x_set_glyph_string_clipping_exactly (struct glyph_string *src, cairo_clip (cr); } - /* RIF: Compute left and right overhang of glyph string S. */ @@ -1331,18 +1269,17 @@ pgtk_compute_glyph_string_overhangs (struct glyph_string *s) } } - -/* Fill rectangle X, Y, W, H with background color of glyph string S. */ - +/* Fill rectangle X, Y, W, H with background color of glyph string + S. */ static void -x_clear_glyph_string_rect (struct glyph_string *s, int x, int y, int w, int h) +pgtk_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, (s->first_glyph->type != STRETCH_GLYPH || s->hl != DRAW_CURSOR)); } - static void fill_background_by_face (struct frame *f, struct face *face, int x, int y, int width, int height) @@ -1384,9 +1321,8 @@ fill_background (struct glyph_string *s, int x, int y, int width, int height) background even if it wouldn't be drawn normally. This is used when a string preceding S draws into the background of S, or S contains the first component of a composition. */ - static void -x_draw_glyph_string_background (struct glyph_string *s, bool force_p) +pgtk_draw_glyph_string_background (struct glyph_string *s, bool force_p) { /* Nothing to do if background has already been drawn or if it shouldn't be drawn in the first place. */ @@ -1413,9 +1349,9 @@ x_draw_glyph_string_background (struct glyph_string *s, bool force_p) || s->font_not_found_p || s->extends_to_end_of_line_p || force_p) { - x_clear_glyph_string_rect (s, s->x, s->y + box_line_width, - s->background_width, - s->height - 2 * box_line_width); + pgtk_clear_glyph_string_rect (s, s->x, s->y + box_line_width, + s->background_width, + s->height - 2 * box_line_width); s->background_filled_p = true; } } @@ -1437,9 +1373,8 @@ pgtk_draw_rectangle (struct frame *f, unsigned long color, int x, int y, } /* Draw the foreground of glyph string S. */ - static void -x_draw_glyph_string_foreground (struct glyph_string *s) +pgtk_draw_glyph_string_foreground (struct glyph_string *s) { int i, x; @@ -1484,9 +1419,8 @@ x_draw_glyph_string_foreground (struct glyph_string *s) } /* Draw the foreground of composite glyph string S. */ - static void -x_draw_composite_glyph_string_foreground (struct glyph_string *s) +pgtk_draw_composite_glyph_string_foreground (struct glyph_string *s) { int i, j, x; struct font *font = s->font; @@ -1575,9 +1509,8 @@ x_draw_composite_glyph_string_foreground (struct glyph_string *s) /* Draw the foreground of glyph string S for glyphless characters. */ - static void -x_draw_glyphless_glyph_string_foreground (struct glyph_string *s) +pgtk_draw_glyphless_glyph_string_foreground (struct glyph_string *s) { struct glyph *glyph = s->first_glyph; unsigned char2b[8]; @@ -1672,20 +1605,18 @@ x_draw_glyphless_glyph_string_foreground (struct glyph_string *s) #define HIGHLIGHT_COLOR_DARK_BOOST_LIMIT 48000 -/* Allocate a color which is lighter or darker than *PIXEL by FACTOR - or DELTA. Try a color with RGB values multiplied by FACTOR first. - If this produces the same color as PIXEL, try a color where all RGB - values have DELTA added. Return the allocated color in *PIXEL. - DISPLAY is the X display, CMAP is the colormap to operate on. - Value is non-zero if successful. */ +/* Compute a color which is lighter or darker than *PIXEL by FACTOR or + DELTA. Try a color with RGB values multiplied by FACTOR first. If + this produces the same color as PIXEL, try a color where all RGB + values have DELTA added. Return the computed color in *PIXEL. F + is the frame to act on. */ -static bool -x_alloc_lighter_color (struct frame *f, unsigned long *pixel, double factor, - int delta) +static void +pgtk_compute_lighter_color (struct frame *f, unsigned long *pixel, + double factor, int delta) { Emacs_Color color, new; long bright; - bool success_p; /* Get RGB color values. */ color.pixel = *pixel; @@ -1725,33 +1656,28 @@ x_alloc_lighter_color (struct frame *f, unsigned long *pixel, double factor, } } - /* Try to allocate the color. */ - new.pixel = new.red >> 8 << 16 | new.green >> 8 << 8 | new.blue >> 8; - success_p = true; - if (success_p) + new.pixel = (new.red >> 8 << 16 + | new.green >> 8 << 8 + | new.blue >> 8); + + if (new.pixel == *pixel) { - if (new.pixel == *pixel) - { - /* If we end up with the same color as before, try adding - delta to the RGB values. */ - new.red = min (0xffff, delta + color.red); - new.green = min (0xffff, delta + color.green); - new.blue = min (0xffff, delta + color.blue); - new.pixel = - new.red >> 8 << 16 | new.green >> 8 << 8 | new.blue >> 8; - success_p = true; - } - else - success_p = true; - *pixel = new.pixel; + /* If we end up with the same color as before, try adding + delta to the RGB values. */ + new.red = min (0xffff, delta + color.red); + new.green = min (0xffff, delta + color.green); + new.blue = min (0xffff, delta + color.blue); + new.pixel = (new.red >> 8 << 16 + | new.green >> 8 << 8 + | new.blue >> 8); } - return success_p; + *pixel = new.pixel; } static void -x_fill_trapezoid_for_relief (struct frame *f, unsigned long color, int x, - int y, int width, int height, int top_p) +pgtk_fill_trapezoid_for_relief (struct frame *f, unsigned long color, int x, + int y, int width, int height, int top_p) { cairo_t *cr; @@ -1775,9 +1701,9 @@ enum corners }; static void -x_erase_corners_for_relief (struct frame *f, unsigned long color, int x, - int y, int width, int height, double radius, - double margin, int corners) +pgtk_erase_corners_for_relief (struct frame *f, unsigned long color, int x, + int y, int width, int height, double radius, + double margin, int corners) { cairo_t *cr; int i; @@ -1807,16 +1733,9 @@ x_erase_corners_for_relief (struct frame *f, unsigned long color, int x, pgtk_end_cr_clip (f); } -/* Set up the foreground color for drawing relief lines of glyph - string S. RELIEF is a pointer to a struct relief containing the GC - with which lines will be drawn. Use a color that is FACTOR or - DELTA lighter or darker than the relief's background which is found - in S->f->output_data.pgtk->relief_background. If such a color cannot - be allocated, use DEFAULT_PIXEL, instead. */ - static void -x_setup_relief_color (struct frame *f, struct relief *relief, double factor, - int delta, unsigned long default_pixel) +pgtk_setup_relief_color (struct frame *f, struct relief *relief, double factor, + int delta, unsigned long default_pixel) { Emacs_GC xgcv; struct pgtk_output *di = FRAME_X_OUTPUT (f); @@ -1826,16 +1745,15 @@ x_setup_relief_color (struct frame *f, struct relief *relief, double factor, /* Allocate new color. */ xgcv.foreground = default_pixel; pixel = background; - if (x_alloc_lighter_color (f, &pixel, factor, delta)) - xgcv.foreground = relief->pixel = pixel; + pgtk_compute_lighter_color (f, &pixel, factor, delta); + xgcv.foreground = relief->pixel = pixel; relief->xgcv = xgcv; } /* Set up colors for the relief lines around glyph string S. */ - static void -x_setup_relief_colors (struct glyph_string *s) +pgtk_setup_relief_colors (struct glyph_string *s) { struct pgtk_output *di = FRAME_X_OUTPUT (s->f); unsigned long color; @@ -1852,30 +1770,27 @@ x_setup_relief_colors (struct glyph_string *s) color = s->xgcv.background; } - if (TRUE) + if (!di->relief_background_valid_p + || di->relief_background != color) { + di->relief_background_valid_p = true; di->relief_background = color; - x_setup_relief_color (s->f, &di->white_relief, 1.2, 0x8000, - WHITE_PIX_DEFAULT (s->f)); - x_setup_relief_color (s->f, &di->black_relief, 0.6, 0x4000, - BLACK_PIX_DEFAULT (s->f)); + pgtk_setup_relief_color (s->f, &di->white_relief, 1.2, 0x8000, + WHITE_PIX_DEFAULT (s->f)); + pgtk_setup_relief_color (s->f, &di->black_relief, 0.6, 0x4000, + BLACK_PIX_DEFAULT (s->f)); } } - static void -x_set_clip_rectangles (struct frame *f, cairo_t * cr, XRectangle * rectangles, - int n) +pgtk_set_clip_rectangles (struct frame *f, cairo_t *cr, + XRectangle *rectangles, int n) { if (n > 0) { for (int i = 0; i < n; i++) - { - cairo_rectangle (cr, - rectangles[i].x, - rectangles[i].y, - rectangles[i].width, rectangles[i].height); - } + cairo_rectangle (cr, rectangles[i].x, rectangles[i].y, + rectangles[i].width, rectangles[i].height); cairo_clip (cr); } } @@ -1889,11 +1804,11 @@ x_set_clip_rectangles (struct frame *f, cairo_t * cr, XRectangle * rectangles, when drawing. */ static void -x_draw_relief_rect (struct frame *f, - int left_x, int top_y, int right_x, int bottom_y, - int hwidth, int vwidth, bool raised_p, bool top_p, - bool bot_p, bool left_p, bool right_p, - XRectangle * clip_rect) +pgtk_draw_relief_rect (struct frame *f, + int left_x, int top_y, int right_x, int bottom_y, + int hwidth, int vwidth, bool raised_p, bool top_p, + bool bot_p, bool left_p, bool right_p, + XRectangle *clip_rect) { unsigned long top_left_color, bottom_right_color; int corners = 0; @@ -1911,7 +1826,7 @@ x_draw_relief_rect (struct frame *f, bottom_right_color = FRAME_X_OUTPUT (f)->white_relief.xgcv.foreground; } - x_set_clip_rectangles (f, cr, clip_rect, 1); + pgtk_set_clip_rectangles (f, cr, clip_rect, 1); if (left_p) { @@ -1937,8 +1852,8 @@ x_draw_relief_rect (struct frame *f, pgtk_fill_rectangle (f, top_left_color, left_x, top_y, 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); + pgtk_fill_trapezoid_for_relief (f, top_left_color, left_x, top_y, + right_x + 1 - left_x, hwidth, 1); } if (bot_p) { @@ -1947,9 +1862,9 @@ x_draw_relief_rect (struct frame *f, bottom_y + 1 - hwidth, right_x + 1 - left_x, hwidth, false); else - x_fill_trapezoid_for_relief (f, bottom_right_color, - left_x, bottom_y + 1 - hwidth, - right_x + 1 - left_x, hwidth, 0); + pgtk_fill_trapezoid_for_relief (f, bottom_right_color, + left_x, bottom_y + 1 - hwidth, + right_x + 1 - left_x, hwidth, 0); } if (left_p && vwidth > 1) pgtk_fill_rectangle (f, bottom_right_color, left_x, top_y, @@ -1958,11 +1873,9 @@ x_draw_relief_rect (struct frame *f, pgtk_fill_rectangle (f, bottom_right_color, left_x, top_y, right_x + 1 - left_x, 1, false); if (corners) - { - x_erase_corners_for_relief (f, FRAME_BACKGROUND_PIXEL (f), left_x, - top_y, right_x - left_x + 1, - bottom_y - top_y + 1, 6, 1, corners); - } + pgtk_erase_corners_for_relief (f, FRAME_BACKGROUND_PIXEL (f), left_x, + top_y, right_x - left_x + 1, + bottom_y - top_y + 1, 6, 1, corners); pgtk_end_cr_clip (f); } @@ -1975,10 +1888,10 @@ x_draw_relief_rect (struct frame *f, rectangle to use when drawing. */ static void -x_draw_box_rect (struct glyph_string *s, - int left_x, int top_y, int right_x, int bottom_y, int hwidth, - int vwidth, bool left_p, bool right_p, - XRectangle * clip_rect) +pgtk_draw_box_rect (struct glyph_string *s, int left_x, + int top_y, int right_x, int bottom_y, int hwidth, + int vwidth, bool left_p, bool right_p, + XRectangle * clip_rect) { unsigned long foreground_backup; @@ -1987,7 +1900,7 @@ x_draw_box_rect (struct glyph_string *s, foreground_backup = s->xgcv.foreground; s->xgcv.foreground = s->face->box_color; - x_set_clip_rectangles (s->f, cr, clip_rect, 1); + pgtk_set_clip_rectangles (s->f, cr, clip_rect, 1); /* Top. */ pgtk_fill_rectangle (s->f, s->xgcv.foreground, @@ -2020,7 +1933,7 @@ x_draw_box_rect (struct glyph_string *s, /* Draw a box around glyph string S. */ static void -x_draw_glyph_string_box (struct glyph_string *s) +pgtk_draw_glyph_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; @@ -2053,26 +1966,20 @@ x_draw_glyph_string_box (struct glyph_string *s) get_glyph_string_clip_rect (s, &clip_rect); if (s->face->box == FACE_SIMPLE_BOX) - x_draw_box_rect (s, left_x, top_y, right_x, bottom_y, hwidth, - vwidth, left_p, right_p, &clip_rect); + pgtk_draw_box_rect (s, left_x, top_y, right_x, bottom_y, hwidth, + vwidth, left_p, right_p, &clip_rect); else { - x_setup_relief_colors (s); - x_draw_relief_rect (s->f, left_x, top_y, right_x, bottom_y, hwidth, - vwidth, raised_p, true, true, left_p, right_p, - &clip_rect); + pgtk_setup_relief_colors (s); + pgtk_draw_relief_rect (s->f, left_x, top_y, right_x, bottom_y, hwidth, + vwidth, raised_p, true, true, left_p, right_p, + &clip_rect); } } static void -x_get_scale_factor (int *scale_x, int *scale_y) -{ - *scale_x = *scale_y = 1; -} - -static void -x_draw_horizontal_wave (struct frame *f, unsigned long color, int x, int y, - int width, int height, int wave_length) +pgtk_draw_horizontal_wave (struct frame *f, unsigned long color, int x, int y, + int width, int height, int wave_length) { cairo_t *cr; double dx = wave_length, dy = height - 1; @@ -2111,34 +2018,19 @@ x_draw_horizontal_wave (struct frame *f, unsigned long color, int x, int y, pgtk_end_cr_clip (f); } -/* - Draw a wavy line under S. The wave fills wave_height pixels from y0. - - x0 wave_length = 2 - -- - y0 * * * * * - |* * * * * * * * * - wave_height = 3 | * * * * - -*/ static void -x_draw_underwave (struct glyph_string *s, unsigned long color) +pgtk_draw_underwave (struct glyph_string *s, unsigned long color) { - /* Adjust for scale/HiDPI. */ - int scale_x, scale_y; + int wave_height = 3, wave_length = 2; - x_get_scale_factor (&scale_x, &scale_y); - - int wave_height = 3 * scale_y, wave_length = 2 * scale_x; - - x_draw_horizontal_wave (s->f, color, s->x, s->ybase - wave_height + 3, - s->width, wave_height, wave_length); + pgtk_draw_horizontal_wave (s->f, color, s->x, s->ybase - wave_height + 3, + s->width, wave_height, wave_length); } /* Draw a relief around the image glyph string S. */ static void -x_draw_image_relief (struct glyph_string *s) +pgtk_draw_image_relief (struct glyph_string *s) { int x1, y1, thick; bool raised_p, top_p, bot_p, left_p, right_p; @@ -2221,33 +2113,29 @@ x_draw_image_relief (struct glyph_string *s) if (s->slice.y + s->slice.height == s->img->height) y1 += thick + extra_y, bot_p = true; - x_setup_relief_colors (s); + pgtk_setup_relief_colors (s); get_glyph_string_clip_rect (s, &r); - x_draw_relief_rect (s->f, x, y, x1, y1, thick, thick, raised_p, - top_p, bot_p, left_p, right_p, &r); + pgtk_draw_relief_rect (s->f, x, y, x1, y1, thick, thick, raised_p, + top_p, bot_p, left_p, right_p, &r); } /* Draw part of the background of glyph string S. X, Y, W, and H give the rectangle to draw. */ static void -x_draw_glyph_string_bg_rect (struct glyph_string *s, int x, int y, int w, - int h) +pgtk_draw_glyph_string_bg_rect (struct glyph_string *s, int x, int y, int w, + int h) { if (s->stippled_p) - { - /* Fill background with a stipple pattern. */ - - fill_background (s, x, y, w, h); - } + fill_background (s, x, y, w, h); else - x_clear_glyph_string_rect (s, x, y, w, h); + pgtk_clear_glyph_string_rect (s, x, y, w, h); } static void -x_cr_draw_image (struct frame *f, Emacs_GC *gc, cairo_pattern_t *image, - int src_x, int src_y, int width, int height, - int dest_x, int dest_y, bool overlay_p) +pgtk_cr_draw_image (struct frame *f, Emacs_GC *gc, cairo_pattern_t *image, + int src_x, int src_y, int width, int height, + int dest_x, int dest_y, bool overlay_p) { cairo_t *cr = pgtk_begin_cr_clip (f); @@ -2283,7 +2171,7 @@ x_cr_draw_image (struct frame *f, Emacs_GC *gc, cairo_pattern_t *image, /* Draw foreground of image glyph string S. */ static void -x_draw_image_foreground (struct glyph_string *s) +pgtk_draw_image_foreground (struct glyph_string *s) { int x = s->x; int y = s->ybase - image_ascent (s->img, s->face, &s->slice); @@ -2305,10 +2193,10 @@ x_draw_image_foreground (struct glyph_string *s) if (s->img->cr_data) { cairo_t *cr = pgtk_begin_cr_clip (s->f); - x_set_glyph_string_clipping (s, cr); - x_cr_draw_image (s->f, &s->xgcv, s->img->cr_data, - s->slice.x, s->slice.y, s->slice.width, s->slice.height, - x, y, true); + pgtk_set_glyph_string_clipping (s, cr); + pgtk_cr_draw_image (s->f, &s->xgcv, s->img->cr_data, + s->slice.x, s->slice.y, s->slice.width, s->slice.height, + x, y, true); if (!s->img->mask) { /* When the image has a mask, we can expect that at @@ -2320,9 +2208,9 @@ x_draw_image_foreground (struct glyph_string *s) if (s->hl == DRAW_CURSOR) { 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, false); + pgtk_draw_rectangle (s->f, s->xgcv.foreground, x - relief, + y - relief, s->slice.width + relief * 2 - 1, + s->slice.height + relief * 2 - 1, false); } } pgtk_end_cr_clip (s->f); @@ -2348,7 +2236,7 @@ x_draw_image_foreground (struct glyph_string *s) */ static void -x_draw_image_glyph_string (struct glyph_string *s) +pgtk_draw_image_glyph_string (struct glyph_string *s) { int box_line_hwidth = max (s->face->box_vertical_line_width, 0); int box_line_vwidth = max (s->face->box_horizontal_line_width, 0); @@ -2371,41 +2259,39 @@ x_draw_image_glyph_string (struct glyph_string *s) || s->img->pixmap == 0 || s->width != s->background_width) { - { - int x = s->x; - int y = s->y; - int width = s->background_width; + int x = s->x; + int y = s->y; + int width = s->background_width; - if (s->first_glyph->left_box_line_p - && s->slice.x == 0) - { - x += box_line_hwidth; - width -= box_line_hwidth; - } + if (s->first_glyph->left_box_line_p + && s->slice.x == 0) + { + x += box_line_hwidth; + width -= box_line_hwidth; + } - if (s->slice.y == 0) - y += box_line_vwidth; + if (s->slice.y == 0) + y += box_line_vwidth; - x_draw_glyph_string_bg_rect (s, x, y, width, height); - } + pgtk_draw_glyph_string_bg_rect (s, x, y, width, height); s->background_filled_p = true; } /* Draw the foreground. */ - x_draw_image_foreground (s); + pgtk_draw_image_foreground (s); /* If we must draw a relief around the image, do it. */ if (s->img->relief || s->hl == DRAW_IMAGE_RAISED || s->hl == DRAW_IMAGE_SUNKEN) - x_draw_image_relief (s); + pgtk_draw_image_relief (s); } /* Draw stretch glyph string S. */ static void -x_draw_stretch_glyph_string (struct glyph_string *s) +pgtk_draw_stretch_glyph_string (struct glyph_string *s) { eassert (s->first_glyph->type == STRETCH_GLYPH); @@ -2441,7 +2327,7 @@ x_draw_stretch_glyph_string (struct glyph_string *s) x -= width; /* Draw cursor. */ - x_draw_glyph_string_bg_rect (s, x, s->y, width, s->height); + pgtk_draw_glyph_string_bg_rect (s, x, s->y, width, s->height); /* Clear rest using the GC of the original non-cursor face. */ if (width < background_width) @@ -2457,7 +2343,7 @@ x_draw_stretch_glyph_string (struct glyph_string *s) x = s->x; if (s->row->mouse_face_p && cursor_in_mouse_face_p (s->w)) { - x_set_mouse_face_gc (s); + pgtk_set_mouse_face_gc (s); color = s->xgcv.foreground; } else @@ -2466,18 +2352,13 @@ x_draw_stretch_glyph_string (struct glyph_string *s) cairo_t *cr = pgtk_begin_cr_clip (s->f); get_glyph_string_clip_rect (s, &r); - x_set_clip_rectangles (s->f, cr, &r, 1); + pgtk_set_clip_rectangles (s->f, cr, &r, 1); if (s->face->stipple) - { - /* Fill background with a stipple pattern. */ - fill_background (s, x, y, w, h); - } + fill_background (s, x, y, w, h); else - { - pgtk_fill_rectangle (s->f, color, x, y, w, h, - true); - } + pgtk_fill_rectangle (s->f, color, x, y, w, h, + true); pgtk_end_cr_clip (s->f); } @@ -2495,8 +2376,9 @@ x_draw_stretch_glyph_string (struct glyph_string *s) background_width -= text_left_x - x; x = text_left_x; } + if (background_width > 0) - x_draw_glyph_string_bg_rect (s, x, s->y, background_width, s->height); + pgtk_draw_glyph_string_bg_rect (s, x, s->y, background_width, s->height); } s->background_filled_p = true; @@ -2521,19 +2403,19 @@ pgtk_draw_glyph_string (struct glyph_string *s) if (next->first_glyph->type != IMAGE_GLYPH) { cairo_t *cr = pgtk_begin_cr_clip (next->f); - x_set_glyph_string_gc (next); - x_set_glyph_string_clipping (next, cr); + pgtk_set_glyph_string_gc (next); + pgtk_set_glyph_string_clipping (next, cr); if (next->first_glyph->type == STRETCH_GLYPH) - x_draw_stretch_glyph_string (next); + pgtk_draw_stretch_glyph_string (next); else - x_draw_glyph_string_background (next, true); + pgtk_draw_glyph_string_background (next, true); next->num_clips = 0; pgtk_end_cr_clip (next->f); } } /* Set up S->gc, set clipping and draw S. */ - x_set_glyph_string_gc (s); + pgtk_set_glyph_string_gc (s); cairo_t *cr = pgtk_begin_cr_clip (s->f); @@ -2545,10 +2427,10 @@ pgtk_draw_glyph_string (struct glyph_string *s) || s->first_glyph->type == COMPOSITE_GLYPH)) { - x_set_glyph_string_clipping (s, cr); - x_draw_glyph_string_background (s, true); - x_draw_glyph_string_box (s); - x_set_glyph_string_clipping (s, cr); + pgtk_set_glyph_string_clipping (s, cr); + pgtk_draw_glyph_string_background (s, true); + pgtk_draw_glyph_string_box (s); + pgtk_set_glyph_string_clipping (s, cr); relief_drawn_p = true; } else if (!s->clip_head /* draw_glyphs didn't specify a clip mask. */ @@ -2558,14 +2440,14 @@ pgtk_draw_glyph_string (struct glyph_string *s) /* We must clip just this glyph. left_overhang part has already drawn when s->prev was drawn, and right_overhang part will be drawn later when s->next is drawn. */ - x_set_glyph_string_clipping_exactly (s, s, cr); + pgtk_set_glyph_string_clipping_exactly (s, s, cr); else - x_set_glyph_string_clipping (s, cr); + pgtk_set_glyph_string_clipping (s, cr); switch (s->first_glyph->type) { case IMAGE_GLYPH: - x_draw_image_glyph_string (s); + pgtk_draw_image_glyph_string (s); break; case XWIDGET_GLYPH: @@ -2573,15 +2455,15 @@ pgtk_draw_glyph_string (struct glyph_string *s) break; case STRETCH_GLYPH: - x_draw_stretch_glyph_string (s); + pgtk_draw_stretch_glyph_string (s); break; case CHAR_GLYPH: if (s->for_overlaps) s->background_filled_p = true; else - x_draw_glyph_string_background (s, false); - x_draw_glyph_string_foreground (s); + pgtk_draw_glyph_string_background (s, false); + pgtk_draw_glyph_string_foreground (s); break; case COMPOSITE_GLYPH: @@ -2589,16 +2471,16 @@ pgtk_draw_glyph_string (struct glyph_string *s) && !s->first_glyph->u.cmp.automatic)) s->background_filled_p = true; else - x_draw_glyph_string_background (s, true); - x_draw_composite_glyph_string_foreground (s); + pgtk_draw_glyph_string_background (s, true); + pgtk_draw_composite_glyph_string_foreground (s); break; case GLYPHLESS_GLYPH: if (s->for_overlaps) s->background_filled_p = true; else - x_draw_glyph_string_background (s, true); - x_draw_glyphless_glyph_string_foreground (s); + pgtk_draw_glyph_string_background (s, true); + pgtk_draw_glyphless_glyph_string_foreground (s); break; default: @@ -2609,7 +2491,7 @@ pgtk_draw_glyph_string (struct glyph_string *s) { /* Draw relief if not yet drawn. */ if (!relief_drawn_p && s->face->box != FACE_NO_BOX) - x_draw_glyph_string_box (s); + pgtk_draw_glyph_string_box (s); /* Draw underline. */ if (s->face->underline) @@ -2617,10 +2499,10 @@ pgtk_draw_glyph_string (struct glyph_string *s) if (s->face->underline == FACE_UNDER_WAVE) { if (s->face->underline_defaulted_p) - x_draw_underwave (s, s->xgcv.foreground); + pgtk_draw_underwave (s, s->xgcv.foreground); else { - x_draw_underwave (s, s->face->underline_color); + pgtk_draw_underwave (s, s->face->underline_color); } } else if (s->face->underline == FACE_UNDER_LINE) @@ -2707,10 +2589,8 @@ pgtk_draw_glyph_string (struct glyph_string *s) pgtk_fill_rectangle (s->f, s->xgcv.foreground, s->x, s->y + dy, s->width, h, false); else - { - pgtk_fill_rectangle (s->f, s->face->overline_color, s->x, - s->y + dy, s->width, h, false); - } + pgtk_fill_rectangle (s->f, s->face->overline_color, s->x, + s->y + dy, s->width, h, false); } /* Draw strike-through. */ @@ -2732,10 +2612,8 @@ pgtk_draw_glyph_string (struct glyph_string *s) pgtk_fill_rectangle (s->f, s->xgcv.foreground, s->x, glyph_y + dy, s->width, h, false); else - { - pgtk_fill_rectangle (s->f, s->face->strike_through_color, s->x, - glyph_y + dy, s->width, h, false); - } + pgtk_fill_rectangle (s->f, s->face->strike_through_color, s->x, + glyph_y + dy, s->width, h, false); } if (s->prev) @@ -2751,13 +2629,13 @@ pgtk_draw_glyph_string (struct glyph_string *s) enum draw_glyphs_face save = prev->hl; prev->hl = s->hl; - x_set_glyph_string_gc (prev); + pgtk_set_glyph_string_gc (prev); cairo_save (cr); - x_set_glyph_string_clipping_exactly (s, prev, cr); + pgtk_set_glyph_string_clipping_exactly (s, prev, cr); if (prev->first_glyph->type == CHAR_GLYPH) - x_draw_glyph_string_foreground (prev); + pgtk_draw_glyph_string_foreground (prev); else - x_draw_composite_glyph_string_foreground (prev); + pgtk_draw_composite_glyph_string_foreground (prev); prev->hl = save; prev->num_clips = 0; cairo_restore (cr); @@ -2777,13 +2655,13 @@ pgtk_draw_glyph_string (struct glyph_string *s) enum draw_glyphs_face save = next->hl; next->hl = s->hl; - x_set_glyph_string_gc (next); + pgtk_set_glyph_string_gc (next); cairo_save (cr); - x_set_glyph_string_clipping_exactly (s, next, cr); + pgtk_set_glyph_string_clipping_exactly (s, next, cr); if (next->first_glyph->type == CHAR_GLYPH) - x_draw_glyph_string_foreground (next); + pgtk_draw_glyph_string_foreground (next); else - x_draw_composite_glyph_string_foreground (next); + pgtk_draw_composite_glyph_string_foreground (next); cairo_restore (cr); next->hl = save; next->num_clips = 0; @@ -2848,7 +2726,7 @@ pgtk_clear_frame_area (struct frame *f, int x, int y, int width, int height) /* Draw a hollow box cursor on window W in glyph row ROW. */ static void -x_draw_hollow_cursor (struct window *w, struct glyph_row *row) +pgtk_draw_hollow_cursor (struct window *w, struct glyph_row *row) { struct frame *f = XFRAME (WINDOW_FRAME (w)); int x, y, wd, h; @@ -2881,7 +2759,8 @@ 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, false); + pgtk_draw_rectangle (f, FRAME_X_OUTPUT (f)->cursor_color, + x, y, wd, h - 1, false); pgtk_end_cr_clip (f); } @@ -2893,7 +2772,7 @@ x_draw_hollow_cursor (struct window *w, struct glyph_row *row) --gerd. */ static void -x_draw_bar_cursor (struct window *w, struct glyph_row *row, int width, +pgtk_draw_bar_cursor (struct window *w, struct glyph_row *row, int width, enum text_cursor_kinds kind) { struct frame *f = XFRAME (w->frame); @@ -2991,6 +2870,7 @@ pgtk_draw_window_cursor (struct window *w, struct glyph_row *glyph_row, int x, int cursor_width, bool on_p, bool active_p) { struct frame *f = XFRAME (w->frame); + if (on_p) { w->phys_cursor_type = cursor_type; @@ -3009,7 +2889,7 @@ pgtk_draw_window_cursor (struct window *w, struct glyph_row *glyph_row, int x, switch (cursor_type) { case HOLLOW_BOX_CURSOR: - x_draw_hollow_cursor (w, glyph_row); + pgtk_draw_hollow_cursor (w, glyph_row); break; case FILLED_BOX_CURSOR: @@ -3017,11 +2897,11 @@ pgtk_draw_window_cursor (struct window *w, struct glyph_row *glyph_row, int x, break; case BAR_CURSOR: - x_draw_bar_cursor (w, glyph_row, cursor_width, BAR_CURSOR); + pgtk_draw_bar_cursor (w, glyph_row, cursor_width, BAR_CURSOR); break; case HBAR_CURSOR: - x_draw_bar_cursor (w, glyph_row, cursor_width, HBAR_CURSOR); + pgtk_draw_bar_cursor (w, glyph_row, cursor_width, HBAR_CURSOR); break; case NO_CURSOR: @@ -3053,11 +2933,11 @@ pgtk_copy_bits (struct frame *f, cairo_rectangle_t *src_rect, cairo_t *cr; cairo_surface_t *surface; /* temporary surface */ - surface = - cairo_surface_create_similar (FRAME_CR_SURFACE (f), - CAIRO_CONTENT_COLOR_ALPHA, - (int) src_rect->width, - (int) src_rect->height); + surface + = cairo_surface_create_similar (FRAME_CR_SURFACE (f), + CAIRO_CONTENT_COLOR_ALPHA, + (int) src_rect->width, + (int) src_rect->height); cr = cairo_create (surface); cairo_set_source_surface (cr, FRAME_CR_SURFACE (f), -src_rect->x, @@ -3277,10 +3157,9 @@ pgtk_bitmap_icon (struct frame *f, Lisp_Object file) } if (FRAME_DISPLAY_INFO (f)->bitmaps[bitmap_id - 1].img != NULL) - { - gtk_window_set_icon (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)), - FRAME_DISPLAY_INFO (f)->bitmaps[bitmap_id - 1].img); - } + gtk_window_set_icon (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)), + FRAME_DISPLAY_INFO (f)->bitmaps[bitmap_id - 1].img); + f->output_data.pgtk->icon_bitmap = bitmap_id; return false; @@ -3544,10 +3423,10 @@ pgtk_define_fringe_bitmap (int which, unsigned short *bits, int h, int wd) { i = max_fringe_bmp; max_fringe_bmp = which + 20; - fringe_bmp = - (cairo_pattern_t **) xrealloc (fringe_bmp, - max_fringe_bmp * - sizeof (cairo_pattern_t *)); + fringe_bmp + = (cairo_pattern_t **) xrealloc (fringe_bmp, + max_fringe_bmp * + sizeof (cairo_pattern_t *)); while (i < max_fringe_bmp) fringe_bmp[i++] = 0; } @@ -3608,41 +3487,6 @@ pgtk_clip_to_row (struct window *w, struct glyph_row *row, } static void -pgtk_cr_draw_image (struct frame *f, Emacs_GC * gc, cairo_pattern_t * image, - int src_x, int src_y, int width, int height, - int dest_x, int dest_y, bool overlay_p) -{ - cairo_t *cr = pgtk_begin_cr_clip (f); - - if (overlay_p) - cairo_rectangle (cr, dest_x, dest_y, width, height); - else - { - pgtk_set_cr_source_with_gc_background (f, gc, false); - cairo_rectangle (cr, dest_x, dest_y, width, height); - cairo_fill_preserve (cr); - } - cairo_translate (cr, dest_x - src_x, dest_y - src_y); - - cairo_surface_t *surface; - cairo_pattern_get_surface (image, &surface); - cairo_format_t format = cairo_image_surface_get_format (surface); - if (format != CAIRO_FORMAT_A8 && format != CAIRO_FORMAT_A1) - { - cairo_set_source (cr, image); - cairo_fill (cr); - } - else - { - pgtk_set_cr_source_with_gc_foreground (f, gc, false); - cairo_clip (cr); - cairo_mask (cr, image); - } - - pgtk_end_cr_clip (f); -} - -static void pgtk_draw_fringe_bitmap (struct window *w, struct glyph_row *row, struct draw_fringe_bitmap_params *p) { @@ -3656,10 +3500,10 @@ pgtk_draw_fringe_bitmap (struct window *w, struct glyph_row *row, if (p->bx >= 0 && !p->overlay_p) { - /* In case the same realized face is used for fringes and - for something displayed in the text (e.g. face `region' on + /* In case the same realized face is used for fringes and for + something displayed in the text (e.g. face `region' on mono-displays, the fill style may have been changed to - FillSolid in x_draw_glyph_string_background. */ + FillSolid in pgtk_draw_glyph_string_background. */ if (face->stipple) { fill_background_by_face (f, face, p->bx, p->by, p->nx, p->ny); @@ -3707,7 +3551,8 @@ static int hourglass_enter_count = 0; static void hourglass_cb (struct atimer *timer) { - /*NOP*/} + +} static void pgtk_show_hourglass (struct frame *f) @@ -3715,7 +3560,9 @@ pgtk_show_hourglass (struct frame *f) struct pgtk_output *x = FRAME_X_OUTPUT (f); if (x->hourglass_widget != NULL) gtk_widget_destroy (x->hourglass_widget); - x->hourglass_widget = gtk_event_box_new (); /* gtk_event_box is GDK_INPUT_ONLY. */ + + /* This creates a GDK_INPUT_ONLY window. */ + x->hourglass_widget = gtk_event_box_new (); gtk_widget_set_has_window (x->hourglass_widget, true); gtk_fixed_put (GTK_FIXED (FRAME_GTK_WIDGET (f)), x->hourglass_widget, 0, 0); gtk_widget_show (x->hourglass_widget); @@ -3724,17 +3571,16 @@ pgtk_show_hourglass (struct frame *f) gdk_window_set_cursor (gtk_widget_get_window (x->hourglass_widget), x->hourglass_cursor); - /* For cursor animation, we receive signals, set pending_signals, and dispatch. */ + /* For cursor animation, we receive signals, set pending_signals, + and wait for the signal handler to run. */ if (hourglass_enter_count++ == 0) { struct timespec ts = make_timespec (0, 50 * 1000 * 1000); if (hourglass_atimer != NULL) cancel_atimer (hourglass_atimer); - hourglass_atimer = - start_atimer (ATIMER_CONTINUOUS, ts, hourglass_cb, NULL); + hourglass_atimer + = start_atimer (ATIMER_CONTINUOUS, ts, hourglass_cb, NULL); } - - /* Cursor frequently stops animation. gtk's bug? */ } static void @@ -3795,35 +3641,19 @@ static struct redisplay_interface pgtk_redisplay_interface = { pgtk_default_font_parameter, }; -static void -pgtk_redraw_scroll_bars (struct frame *f) -{ -} - void pgtk_clear_frame (struct frame *f) -/* -------------------------------------------------------------------------- - External (hook): Erase the entire frame - -------------------------------------------------------------------------- */ { - /* comes on initial frame because we have - after-make-frame-functions = select-frame */ if (!FRAME_DEFAULT_FACE (f)) return; - /* mark_window_cursors_off (XWINDOW (FRAME_ROOT_WINDOW (f))); */ + mark_window_cursors_off (XWINDOW (FRAME_ROOT_WINDOW (f))); block_input (); - pgtk_clear_area (f, 0, 0, FRAME_PIXEL_WIDTH (f), FRAME_PIXEL_HEIGHT (f)); - - /* as of 2006/11 or so this is now needed */ - pgtk_redraw_scroll_bars (f); unblock_input (); } -/* Invert the middle quarter of the frame for .15 sec. */ - static void recover_from_visible_bell (struct atimer *timer) { @@ -3839,86 +3669,90 @@ recover_from_visible_bell (struct atimer *timer) FRAME_X_OUTPUT (f)->atimer_visible_bell = NULL; } +/* Invert the middle quarter of the frame for .15 sec. */ + static void pgtk_flash (struct frame *f) { - { - if (!FRAME_CR_CONTEXT (f)) - return; + cairo_surface_t *surface_orig, *surface; + cairo_t *cr; + int width, height, flash_height, flash_left, flash_right; + struct timespec delay; - block_input (); + if (!FRAME_CR_CONTEXT (f)) + return; - cairo_surface_t *surface_orig = FRAME_CR_SURFACE (f); + block_input (); - int width = FRAME_CR_SURFACE_DESIRED_WIDTH (f); - int height = FRAME_CR_SURFACE_DESIRED_HEIGHT (f); - cairo_surface_t *surface = - cairo_surface_create_similar (surface_orig, CAIRO_CONTENT_COLOR_ALPHA, - width, height); + surface_orig = FRAME_CR_SURFACE (f); - cairo_t *cr = cairo_create (surface); - cairo_set_source_surface (cr, surface_orig, 0, 0); - cairo_rectangle (cr, 0, 0, width, height); - cairo_clip (cr); - cairo_paint (cr); + width = FRAME_CR_SURFACE_DESIRED_WIDTH (f); + height = FRAME_CR_SURFACE_DESIRED_HEIGHT (f); + surface = cairo_surface_create_similar (surface_orig, + CAIRO_CONTENT_COLOR_ALPHA, + width, height); - cairo_set_source_rgb (cr, 1, 1, 1); - cairo_set_operator (cr, CAIRO_OPERATOR_DIFFERENCE); + cr = cairo_create (surface); + cairo_set_source_surface (cr, surface_orig, 0, 0); + cairo_rectangle (cr, 0, 0, width, height); + cairo_clip (cr); + cairo_paint (cr); + + cairo_set_source_rgb (cr, 1, 1, 1); + cairo_set_operator (cr, CAIRO_OPERATOR_DIFFERENCE); + + /* Get the height not including a menu bar widget. */ + height = FRAME_PIXEL_HEIGHT (f); + /* Height of each line to flash. */ + flash_height = FRAME_LINE_HEIGHT (f); + /* These will be the left and right margins of the rectangles. */ + flash_left = FRAME_INTERNAL_BORDER_WIDTH (f); + flash_right = (FRAME_PIXEL_WIDTH (f) + - FRAME_INTERNAL_BORDER_WIDTH (f)); + width = flash_right - flash_left; + + /* If window is tall, flash top and bottom line. */ + if (height > 3 * FRAME_LINE_HEIGHT (f)) + { + cairo_rectangle (cr, + flash_left, + (FRAME_INTERNAL_BORDER_WIDTH (f) + + FRAME_TOP_MARGIN_HEIGHT (f)), + width, flash_height); + cairo_fill (cr); + cairo_rectangle (cr, + flash_left, + (height - flash_height + - FRAME_INTERNAL_BORDER_WIDTH (f)), + width, flash_height); + cairo_fill (cr); + } + else { - /* 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)) - { - cairo_rectangle (cr, - flash_left, - (FRAME_INTERNAL_BORDER_WIDTH (f) - + FRAME_TOP_MARGIN_HEIGHT (f)), - width, flash_height); - cairo_fill (cr); + /* If it is short, flash it all. */ + cairo_rectangle (cr, + flash_left, FRAME_INTERNAL_BORDER_WIDTH (f), + width, height - 2 * FRAME_INTERNAL_BORDER_WIDTH (f)); + cairo_fill (cr); + } - cairo_rectangle (cr, - flash_left, - (height - flash_height - - FRAME_INTERNAL_BORDER_WIDTH (f)), - width, flash_height); - cairo_fill (cr); - } - else - { - /* If it is short, flash it all. */ - cairo_rectangle (cr, - flash_left, FRAME_INTERNAL_BORDER_WIDTH (f), - width, height - 2 * FRAME_INTERNAL_BORDER_WIDTH (f)); - cairo_fill (cr); - } + FRAME_X_OUTPUT (f)->cr_surface_visible_bell = surface; - FRAME_X_OUTPUT (f)->cr_surface_visible_bell = surface; - { - struct timespec delay = make_timespec (0, 50 * 1000 * 1000); - if (FRAME_X_OUTPUT (f)->atimer_visible_bell != NULL) - { - cancel_atimer (FRAME_X_OUTPUT (f)->atimer_visible_bell); - FRAME_X_OUTPUT (f)->atimer_visible_bell = NULL; - } - FRAME_X_OUTPUT (f)->atimer_visible_bell = - start_atimer (ATIMER_RELATIVE, delay, recover_from_visible_bell, f); - } + delay = make_timespec (0, 50 * 1000 * 1000); + if (FRAME_X_OUTPUT (f)->atimer_visible_bell != NULL) + { + cancel_atimer (FRAME_X_OUTPUT (f)->atimer_visible_bell); + FRAME_X_OUTPUT (f)->atimer_visible_bell = NULL; } - cairo_destroy (cr); - unblock_input (); - } + FRAME_X_OUTPUT (f)->atimer_visible_bell + = start_atimer (ATIMER_RELATIVE, delay, recover_from_visible_bell, f); + + + cairo_destroy (cr); + unblock_input (); } /* Make audible bell. */ @@ -3999,8 +3833,9 @@ pgtk_send_scroll_bar_event (Lisp_Object window, enum scroll_bar_part part, EVENT_INIT (inev.ie); - inev.ie.kind = - horizontal ? HORIZONTAL_SCROLL_BAR_CLICK_EVENT : SCROLL_BAR_CLICK_EVENT; + inev.ie.kind = (horizontal + ? HORIZONTAL_SCROLL_BAR_CLICK_EVENT + : SCROLL_BAR_CLICK_EVENT); inev.ie.frame_or_window = window; inev.ie.arg = Qnil; inev.ie.timestamp = 0; @@ -4108,7 +3943,7 @@ xg_end_scroll_callback (GtkWidget * widget, and X window of the scroll bar in BAR. */ static void -x_create_toolkit_scroll_bar (struct frame *f, struct scroll_bar *bar) +pgtk_create_toolkit_scroll_bar (struct frame *f, struct scroll_bar *bar) { const char *scroll_bar_name = SCROLL_BAR_NAME; @@ -4119,8 +3954,8 @@ x_create_toolkit_scroll_bar (struct frame *f, struct scroll_bar *bar) } static void -x_create_horizontal_toolkit_scroll_bar (struct frame *f, - struct scroll_bar *bar) +pgtk_create_horizontal_toolkit_scroll_bar (struct frame *f, + struct scroll_bar *bar) { const char *scroll_bar_name = SCROLL_BAR_HORIZONTAL_NAME; @@ -4135,30 +3970,28 @@ x_create_horizontal_toolkit_scroll_bar (struct frame *f, displaying PORTION out of a whole WHOLE, and our position POSITION. */ static void -x_set_toolkit_scroll_bar_thumb (struct scroll_bar *bar, int portion, - int position, int whole) +pgtk_set_toolkit_scroll_bar_thumb (struct scroll_bar *bar, int portion, + int position, int whole) { xg_set_toolkit_scroll_bar_thumb (bar, portion, position, whole); } static void -x_set_toolkit_horizontal_scroll_bar_thumb (struct scroll_bar *bar, - int portion, int position, - int whole) +pgtk_set_toolkit_horizontal_scroll_bar_thumb (struct scroll_bar *bar, + int portion, int position, + int whole) { xg_set_toolkit_horizontal_scroll_bar_thumb (bar, portion, position, whole); } - - /* Create a scroll bar and return the scroll bar vector for it. W is the Emacs window on which to create the scroll bar. TOP, LEFT, WIDTH and HEIGHT are the pixel coordinates and dimensions of the scroll bar. */ static struct scroll_bar * -x_scroll_bar_create (struct window *w, int top, int left, - int width, int height, bool horizontal) +pgtk_scroll_bar_create (struct window *w, int top, int left, + int width, int height, bool horizontal) { struct frame *f = XFRAME (w->frame); struct scroll_bar *bar @@ -4168,9 +4001,9 @@ x_scroll_bar_create (struct window *w, int top, int left, block_input (); if (horizontal) - x_create_horizontal_toolkit_scroll_bar (f, bar); + pgtk_create_horizontal_toolkit_scroll_bar (f, bar); else - x_create_toolkit_scroll_bar (f, bar); + pgtk_create_toolkit_scroll_bar (f, bar); XSETWINDOW (bar->window, w); bar->top = top; @@ -4208,7 +4041,7 @@ x_scroll_bar_create (struct window *w, int top, int left, nil. */ static void -x_scroll_bar_remove (struct scroll_bar *bar) +pgtk_scroll_bar_remove (struct scroll_bar *bar) { struct frame *f = XFRAME (WINDOW_FRAME (XWINDOW (bar->window))); block_input (); @@ -4256,7 +4089,7 @@ pgtk_set_vertical_scroll_bar (struct window *w, int portion, int whole, unblock_input (); } - bar = x_scroll_bar_create (w, top, left, width, max (height, 1), false); + bar = pgtk_scroll_bar_create (w, top, left, width, max (height, 1), false); } else { @@ -4296,13 +4129,12 @@ pgtk_set_vertical_scroll_bar (struct window *w, int portion, int whole, unblock_input (); } - x_set_toolkit_scroll_bar_thumb (bar, portion, position, whole); + pgtk_set_toolkit_scroll_bar_thumb (bar, portion, position, whole); XSETVECTOR (barobj, bar); wset_vertical_scroll_bar (w, barobj); } - static void pgtk_set_horizontal_scroll_bar (struct window *w, int portion, int whole, int position) @@ -4334,7 +4166,7 @@ pgtk_set_horizontal_scroll_bar (struct window *w, int portion, int whole, unblock_input (); } - bar = x_scroll_bar_create (w, top, left, width, height, true); + bar = pgtk_scroll_bar_create (w, top, left, width, height, true); } else { @@ -4377,7 +4209,7 @@ pgtk_set_horizontal_scroll_bar (struct window *w, int portion, int whole, unblock_input (); } - x_set_toolkit_horizontal_scroll_bar_thumb (bar, portion, position, whole); + pgtk_set_toolkit_horizontal_scroll_bar_thumb (bar, portion, position, whole); XSETVECTOR (barobj, bar); wset_horizontal_scroll_bar (w, barobj); @@ -4417,7 +4249,6 @@ pgtk_condemn_scroll_bars (struct frame *frame) } } - /* Un-mark WINDOW's scroll bar for deletion in this judgment cycle. Note that WINDOW isn't necessarily condemned at all. */ @@ -4521,7 +4352,7 @@ pgtk_judge_scroll_bars (struct frame *f) { struct scroll_bar *b = XSCROLL_BAR (bar); - x_scroll_bar_remove (b); + pgtk_scroll_bar_remove (b); next = b->next; b->next = b->prev = Qnil; @@ -4641,7 +4472,7 @@ pgtk_query_frame_background_color (struct frame *f, Emacs_Color * bgcolor) } static void -pgtk_free_pixmap (struct frame *_f, Emacs_Pixmap pixmap) +pgtk_free_pixmap (struct frame *f, Emacs_Pixmap pixmap) { if (pixmap) { @@ -4665,17 +4496,18 @@ pgtk_focus_frame (struct frame *f, bool noactivate) } } - static void -set_opacity_recursively (GtkWidget * w, gpointer data) +set_opacity_recursively (GtkWidget *w, gpointer data) { gtk_widget_set_opacity (w, *(double *) data); + if (GTK_IS_CONTAINER (w)) - gtk_container_foreach (GTK_CONTAINER (w), set_opacity_recursively, data); + gtk_container_foreach (GTK_CONTAINER (w), + set_opacity_recursively, data); } static void -x_set_frame_alpha (struct frame *f) +pgtk_set_frame_alpha (struct frame *f) { struct pgtk_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); double alpha = 1.0; @@ -4707,22 +4539,13 @@ x_set_frame_alpha (struct frame *f) static void frame_highlight (struct frame *f) { - /* We used to only do this if Vx_no_window_manager was non-nil, but - the ICCCM (section 4.1.6) says that the window's border pixmap - and border pixel are window attributes which are "private to the - client", so we can always change it to whatever we want. */ block_input (); - /* I recently started to get errors in this XSetWindowBorder, depending on - the window-manager in use, tho something more is at play since I've been - using that same window-manager binary for ever. Let's not crash just - because of this (bug#9310). */ - GtkWidget *w = FRAME_WIDGET (f); - char *css = - g_strdup_printf ("decoration { border: solid %dpx #%06x; }", - f->border_width, - (unsigned int) FRAME_X_OUTPUT (f)->border_pixel & 0x00ffffff); + char *css = g_strdup_printf ("decoration { border: solid %dpx #%06x; }", + f->border_width, + ((unsigned int) FRAME_X_OUTPUT (f)->border_pixel + & 0x00ffffff)); GtkStyleContext *ctxt = gtk_widget_get_style_context (w); GtkCssProvider *css_provider = gtk_css_provider_new (); @@ -4741,33 +4564,32 @@ frame_highlight (struct frame *f) unblock_input (); gui_update_cursor (f, true); - x_set_frame_alpha (f); + pgtk_set_frame_alpha (f); } static void frame_unhighlight (struct frame *f) { - /* We used to only do this if Vx_no_window_manager was non-nil, but - the ICCCM (section 4.1.6) says that the window's border pixmap - and border pixel are window attributes which are "private to the - client", so we can always change it to whatever we want. */ + GtkWidget *w; + char *css; + GtkStyleContext *ctxt; + GtkCssProvider *css_provider, *old; + block_input (); - /* Same as above for XSetWindowBorder (bug#9310). */ - GtkWidget *w = FRAME_WIDGET (f); + w = FRAME_WIDGET (f); - char *css = - g_strdup_printf ("decoration { border: dotted %dpx #ffffff; }", - f->border_width); + css = g_strdup_printf ("decoration { border: dotted %dpx #ffffff; }", + f->border_width); - GtkStyleContext *ctxt = gtk_widget_get_style_context (w); - GtkCssProvider *css_provider = gtk_css_provider_new (); + ctxt = gtk_widget_get_style_context (w); + css_provider = gtk_css_provider_new (); gtk_css_provider_load_from_data (css_provider, css, -1, NULL); gtk_style_context_add_provider (ctxt, GTK_STYLE_PROVIDER (css_provider), GTK_STYLE_PROVIDER_PRIORITY_USER); g_free (css); - GtkCssProvider *old = FRAME_X_OUTPUT (f)->border_color_css_provider; + old = FRAME_X_OUTPUT (f)->border_color_css_provider; FRAME_X_OUTPUT (f)->border_color_css_provider = css_provider; if (old != NULL) { @@ -4777,7 +4599,7 @@ frame_unhighlight (struct frame *f) unblock_input (); gui_update_cursor (f, true); - x_set_frame_alpha (f); + pgtk_set_frame_alpha (f); } @@ -4821,10 +4643,8 @@ pgtk_frame_rehighlight_hook (struct frame *frame) pgtk_frame_rehighlight (FRAME_DISPLAY_INFO (frame)); } - /* Set whether or not the mouse pointer should be visible on frame F. */ - static void pgtk_toggle_invisible_pointer (struct frame *f, bool invisible) { @@ -4836,6 +4656,10 @@ pgtk_toggle_invisible_pointer (struct frame *f, bool invisible) gdk_window_set_cursor (gtk_widget_get_window (FRAME_GTK_WIDGET (f)), cursor); f->pointer_invisible = invisible; + + /* This is needed to make the pointer visible upon receiving a + motion notify event. */ + gdk_display_flush (FRAME_X_DISPLAY (f)); } /* The focus has changed. Update the frames as necessary to reflect @@ -4845,7 +4669,7 @@ pgtk_toggle_invisible_pointer (struct frame *f, bool invisible) Lisp code can tell when the switch took place by examining the events. */ static void -x_new_focus_frame (struct pgtk_display_info *dpyinfo, struct frame *frame) +pgtk_new_focus_frame (struct pgtk_display_info *dpyinfo, struct frame *frame) { struct frame *old_focus = dpyinfo->x_focus_frame; /* doesn't work on wayland */ @@ -4881,9 +4705,6 @@ pgtk_buffer_flipping_unblocked_hook (struct frame *f) static struct terminal * pgtk_create_terminal (struct pgtk_display_info *dpyinfo) -/* -------------------------------------------------------------------------- - Set up use of Gtk before we make the first connection. - -------------------------------------------------------------------------- */ { struct terminal *terminal; @@ -4908,14 +4729,14 @@ pgtk_create_terminal (struct pgtk_display_info *dpyinfo) terminal->menu_show_hook = pgtk_menu_show; terminal->activate_menubar_hook = pgtk_activate_menubar; terminal->popup_dialog_hook = pgtk_popup_dialog; - terminal->change_tab_bar_height_hook = x_change_tab_bar_height; + terminal->change_tab_bar_height_hook = pgtk_change_tab_bar_height; terminal->set_vertical_scroll_bar_hook = pgtk_set_vertical_scroll_bar; terminal->set_horizontal_scroll_bar_hook = pgtk_set_horizontal_scroll_bar; terminal->condemn_scroll_bars_hook = pgtk_condemn_scroll_bars; terminal->redeem_scroll_bar_hook = pgtk_redeem_scroll_bar; terminal->judge_scroll_bars_hook = pgtk_judge_scroll_bars; terminal->get_string_resource_hook = pgtk_get_string_resource; - terminal->delete_frame_hook = x_destroy_window; + terminal->delete_frame_hook = pgtk_destroy_window; terminal->delete_terminal_hook = pgtk_delete_terminal; terminal->query_frame_background_color = pgtk_query_frame_background_color; terminal->defined_color_hook = pgtk_defined_color; @@ -4923,15 +4744,15 @@ pgtk_create_terminal (struct pgtk_display_info *dpyinfo) terminal->set_bitmap_icon_hook = pgtk_bitmap_icon; terminal->implicit_set_name_hook = pgtk_implicitly_set_name; terminal->iconify_frame_hook = pgtk_iconify_frame; - terminal->set_scroll_bar_default_width_hook = - pgtk_set_scroll_bar_default_width; - terminal->set_scroll_bar_default_height_hook = - pgtk_set_scroll_bar_default_height; + terminal->set_scroll_bar_default_width_hook + = pgtk_set_scroll_bar_default_width; + terminal->set_scroll_bar_default_height_hook + = pgtk_set_scroll_bar_default_height; terminal->set_window_size_hook = pgtk_set_window_size; terminal->query_colors = pgtk_query_colors; - terminal->get_focus_frame = x_get_focus_frame; + terminal->get_focus_frame = pgtk_get_focus_frame; terminal->focus_frame_hook = pgtk_focus_frame; - terminal->set_frame_offset_hook = x_set_offset; + terminal->set_frame_offset_hook = pgtk_set_offset; terminal->free_pixmap = pgtk_free_pixmap; terminal->toolkit_position_hook = pgtk_toolkit_position; @@ -4948,7 +4769,7 @@ struct pgtk_window_is_of_frame_recursive_t }; static void -pgtk_window_is_of_frame_recursive (GtkWidget * widget, gpointer data) +pgtk_window_is_of_frame_recursive (GtkWidget *widget, gpointer data) { struct pgtk_window_is_of_frame_recursive_t *datap = data; @@ -4964,14 +4785,13 @@ pgtk_window_is_of_frame_recursive (GtkWidget * widget, gpointer data) return; } - if (GTK_IS_CONTAINER (widget)) { + if (GTK_IS_CONTAINER (widget)) gtk_container_foreach (GTK_CONTAINER (widget), pgtk_window_is_of_frame_recursive, datap); - } } static bool -pgtk_window_is_of_frame (struct frame *f, GdkWindow * window) +pgtk_window_is_of_frame (struct frame *f, GdkWindow *window) { struct pgtk_window_is_of_frame_recursive_t data; data.window = window; @@ -4984,7 +4804,7 @@ pgtk_window_is_of_frame (struct frame *f, GdkWindow * window) /* Like x_window_to_frame but also compares the window with the widget's windows. */ static struct frame * -pgtk_any_window_to_frame (GdkWindow * window) +pgtk_any_window_to_frame (GdkWindow *window) { Lisp_Object tail, frame; struct frame *f, *found = NULL; @@ -5010,7 +4830,6 @@ pgtk_any_window_to_frame (GdkWindow * window) static gboolean pgtk_handle_event (GtkWidget *widget, GdkEvent *event, gpointer *data) { -#if GTK_CHECK_VERSION (3, 18, 0) struct frame *f; union buffered_input_event inev; GtkWidget *frame_widget; @@ -5047,7 +4866,6 @@ pgtk_handle_event (GtkWidget *widget, GdkEvent *event, gpointer *data) return TRUE; } -#endif return FALSE; } @@ -5111,7 +4929,7 @@ pgtk_clear_under_internal_border (struct frame *f) } static gboolean -pgtk_handle_draw (GtkWidget * widget, cairo_t * cr, gpointer * data) +pgtk_handle_draw (GtkWidget *widget, cairo_t *cr, gpointer *data) { struct frame *f; @@ -5137,19 +4955,11 @@ pgtk_handle_draw (GtkWidget * widget, cairo_t * cr, gpointer * data) } static void -size_allocate (GtkWidget * widget, GtkAllocation * alloc, +size_allocate (GtkWidget *widget, GtkAllocation *alloc, gpointer user_data) { struct frame *f = pgtk_any_window_to_frame (gtk_widget_get_window (widget)); - /* Between a frame is created and not shown, size is allocated and - * this handler is called. When that, since the widget's window is - * NULL, we can't get f, pgtk_cr_update_surface_desired_size is not - * called, and its size is 0x0. That causes empty frame. - * - * Fortunately since we know f in pgtk_set_event_handler, we can get - * it through user_data; - */ if (!f) f = user_data; @@ -5161,88 +4971,8 @@ size_allocate (GtkWidget * widget, GtkAllocation * alloc, } static void -x_find_modifier_meanings (struct pgtk_display_info *dpyinfo) -{ - GdkDisplay *gdpy = dpyinfo->gdpy; - GdkKeymap *keymap = gdk_keymap_get_for_display (gdpy); - GdkModifierType state = GDK_META_MASK; - gboolean r = gdk_keymap_map_virtual_modifiers (keymap, &state); - if (r) - { - /* Meta key exists. */ - if (state == GDK_META_MASK) - { - dpyinfo->meta_mod_mask = GDK_MOD1_MASK; /* maybe this is meta. */ - dpyinfo->alt_mod_mask = 0; - } - else - { - dpyinfo->meta_mod_mask = state & ~GDK_META_MASK; - if (dpyinfo->meta_mod_mask == GDK_MOD1_MASK) - dpyinfo->alt_mod_mask = 0; - else - dpyinfo->alt_mod_mask = GDK_MOD1_MASK; - } - } - else - { - dpyinfo->meta_mod_mask = GDK_MOD1_MASK; - dpyinfo->alt_mod_mask = 0; - } - - state = GDK_SUPER_MASK; - r = gdk_keymap_map_virtual_modifiers (keymap, &state); - if (r) - { - /* Super key exists. */ - if (state == GDK_SUPER_MASK) - { - dpyinfo->super_mod_mask = GDK_MOD4_MASK; /* maybe this is super. */ - } - else - { - dpyinfo->super_mod_mask = state & ~GDK_SUPER_MASK; - } - } - else - { - dpyinfo->super_mod_mask = GDK_MOD4_MASK; - } - - state = GDK_HYPER_MASK; - r = gdk_keymap_map_virtual_modifiers (keymap, &state); - if (r) - { - /* Hyper key exists. */ - if (state == GDK_HYPER_MASK) - { - dpyinfo->hyper_mod_mask = GDK_MOD3_MASK; /* maybe this is hyper. */ - } - else - { - dpyinfo->hyper_mod_mask = state & ~GDK_HYPER_MASK; - } - } - else - { - dpyinfo->hyper_mod_mask = GDK_MOD3_MASK; - } - - /* If xmodmap says: - * $ xmodmap | grep mod4 - * mod4 Super_L (0x85), Super_R (0x86), Super_L (0xce), Hyper_L (0xcf) - * then, when mod4 is pressed, both of super and hyper are recognized ON. - * Maybe many people have such configuration, and they don't like such behavior, - * so I disable hyper if such configuration is detected. - */ - if (dpyinfo->hyper_mod_mask == dpyinfo->super_mod_mask) - dpyinfo->hyper_mod_mask = 0; -} - -static void -get_modifier_values (int *mod_ctrl, - int *mod_meta, - int *mod_alt, int *mod_hyper, int *mod_super) +get_modifier_values (int *mod_ctrl, int *mod_meta, int *mod_alt, + int *mod_hyper, int *mod_super) { Lisp_Object tem; @@ -5287,14 +5017,13 @@ pgtk_gtk_to_emacs_modifiers (struct pgtk_display_info *dpyinfo, int state) mod |= shift_modifier; if (state & GDK_CONTROL_MASK) mod |= mod_ctrl; - if (state & dpyinfo->meta_mod_mask) + if (state & GDK_META_MASK || state & GDK_MOD1_MASK) mod |= mod_meta; - if (state & dpyinfo->alt_mod_mask) - mod |= mod_alt; - if (state & dpyinfo->super_mod_mask) + if (state & GDK_SUPER_MASK) mod |= mod_super; - if (state & dpyinfo->hyper_mod_mask) + if (state & GDK_HYPER_MASK) mod |= mod_hyper; + return mod; } @@ -5312,18 +5041,16 @@ pgtk_emacs_to_gtk_modifiers (struct pgtk_display_info *dpyinfo, int state) &mod_super); mask = 0; - if (state & mod_alt) - mask |= dpyinfo->alt_mod_mask; if (state & mod_super) - mask |= dpyinfo->super_mod_mask; + mask |= GDK_SUPER_MASK; if (state & mod_hyper) - mask |= dpyinfo->hyper_mod_mask; + mask |= GDK_HYPER_MASK; if (state & shift_modifier) mask |= GDK_SHIFT_MASK; if (state & mod_ctrl) mask |= GDK_CONTROL_MASK; if (state & mod_meta) - mask |= dpyinfo->meta_mod_mask; + mask |= GDK_MOD1_MASK; return mask; } @@ -5339,7 +5066,7 @@ pgtk_emacs_to_gtk_modifiers (struct pgtk_display_info *dpyinfo, int state) void -pgtk_enqueue_string (struct frame *f, gchar * str) +pgtk_enqueue_string (struct frame *f, gchar *str) { gunichar *ustr, *uptr; @@ -5382,16 +5109,13 @@ pgtk_enqueue_preedit (struct frame *f, Lisp_Object preedit) static gboolean key_press_event (GtkWidget *widget, GdkEvent *event, gpointer *user_data) { - struct coding_system coding; union buffered_input_event inev; ptrdiff_t nbytes = 0; Mouse_HLInfo *hlinfo; + struct frame *f; - USE_SAFE_ALLOCA; - + f = pgtk_any_window_to_frame (gtk_widget_get_window (widget)); EVENT_INIT (inev.ie); - - struct frame *f = pgtk_any_window_to_frame (gtk_widget_get_window (widget)); hlinfo = MOUSE_HL_INFO (f); /* If mouse-highlight is an integer, input clears out @@ -5404,20 +5128,6 @@ key_press_event (GtkWidget *widget, GdkEvent *event, gpointer *user_data) if (f != 0) { - /* While super is pressed, gtk_im_context_filter_keypress() always process the - * key events ignoring super. - * As a work around, don't call it while super or hyper are pressed... - */ - struct pgtk_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); - if (!(event->key.state & (dpyinfo->super_mod_mask | dpyinfo->hyper_mod_mask))) - { - if (pgtk_im_filter_keypress (f, &event->key)) - return TRUE; - } - } - - if (f != 0) - { guint keysym, orig_keysym; /* al%imercury@uunet.uu.net says that making this 81 instead of 80 fixed a bug whereby meta chars made @@ -5434,13 +5144,22 @@ key_press_event (GtkWidget *widget, GdkEvent *event, gpointer *user_data) unsigned char *copy_bufptr = copy_buffer; int copy_bufsiz = sizeof (copy_buffer); int modifiers; - Lisp_Object coding_system = Qlatin_1; Lisp_Object c; - guint state = event->key.state; + guint state; - state |= - pgtk_emacs_to_gtk_modifiers (FRAME_DISPLAY_INFO (f), - extra_keyboard_modifiers); + state = event->key.state; + + /* While super is pressed, the input method will always always + resend the key events ignoring super. As a workaround, don't + filter key events with super or hyper pressed. */ + if (!(event->key.state & (GDK_SUPER_MASK | GDK_HYPER_MASK))) + { + if (pgtk_im_filter_keypress (f, &event->key)) + return TRUE; + } + + state |= pgtk_emacs_to_gtk_modifiers (FRAME_DISPLAY_INFO (f), + extra_keyboard_modifiers); modifiers = state; /* This will have to go some day... */ @@ -5567,9 +5286,6 @@ key_press_event (GtkWidget *widget, GdkEvent *event, gpointer *user_data) || (orig_keysym & (1 << 28)) || (keysym != GDK_KEY_VoidSymbol && nbytes == 0)) && !(event->key.is_modifier - /* Gtk's modifier keys are different from Xlib's ones. - * I need to exclude them. - */ || IsModifierKey (orig_keysym) /* The symbols from GDK_KEY_ISO_Lock to GDK_KEY_ISO_Last_Group_Lock @@ -5582,7 +5298,6 @@ key_press_event (GtkWidget *widget, GdkEvent *event, gpointer *user_data) #endif )) { - STORE_KEYSYM_FOR_DEBUG (keysym); /* make_lispy_event will convert this to a symbolic key. */ inev.ie.kind = NON_ASCII_KEYSTROKE_EVENT; @@ -5593,62 +5308,11 @@ key_press_event (GtkWidget *widget, GdkEvent *event, gpointer *user_data) goto done; } - { /* Raw bytes, not keysym. */ - ptrdiff_t i; - int nchars, len; - - for (i = 0, nchars = 0; i < nbytes; i++) - { - if (ASCII_CHAR_P (copy_bufptr[i])) - nchars++; - STORE_KEYSYM_FOR_DEBUG (copy_bufptr[i]); - } - - if (nchars < nbytes) - { - /* Decode the input data. */ - - /* The input should be decoded with locale `coding_system'. */ - if (!NILP (Vlocale_coding_system)) - coding_system = Vlocale_coding_system; - 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; - } - - /* 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; - inev.ie.device - = pgtk_get_device_for_event (FRAME_DISPLAY_INFO (f), event); - evq_enqueue (&inev); - } - - /* count += nchars; */ - - inev.ie.kind = NO_EVENT; /* Already stored above. */ + { + inev.ie.kind = MULTIBYTE_CHAR_KEYSTROKE_EVENT; + inev.ie.arg = make_unibyte_string ((char *) copy_bufptr, nbytes); + inev.ie.device + = pgtk_get_device_for_event (FRAME_DISPLAY_INFO (f), event); if (keysym == GDK_KEY_VoidSymbol) goto done; @@ -5660,11 +5324,8 @@ done: { XSETFRAME (inev.ie.frame_or_window, f); evq_enqueue (&inev); - /* count++; */ } - SAFE_FREE (); - return TRUE; } @@ -5736,9 +5397,9 @@ map_event (GtkWidget *widget, /* The `z-group' is reset every time a frame becomes invisible. Handle this here. */ if (FRAME_Z_GROUP (f) == z_group_above) - x_set_z_group (f, Qabove, Qnil); + pgtk_set_z_group (f, Qabove, Qnil); else if (FRAME_Z_GROUP (f) == z_group_below) - x_set_z_group (f, Qbelow, Qnil); + pgtk_set_z_group (f, Qbelow, Qnil); } SET_FRAME_VISIBLE (f, 1); @@ -5850,15 +5511,15 @@ delete_event (GtkWidget *widget, a FOCUS_IN_EVENT into *BUFP. */ static void -x_focus_changed (gboolean is_enter, int state, - struct pgtk_display_info *dpyinfo, struct frame *frame, - union buffered_input_event *bufp) +pgtk_focus_changed (gboolean is_enter, int state, + struct pgtk_display_info *dpyinfo, struct frame *frame, + union buffered_input_event *bufp) { if (is_enter) { if (dpyinfo->x_focus_event_frame != frame) { - x_new_focus_frame (dpyinfo, frame); + pgtk_new_focus_frame (dpyinfo, frame); dpyinfo->x_focus_event_frame = frame; /* Don't stop displaying the initial startup message @@ -5883,7 +5544,7 @@ x_focus_changed (gboolean is_enter, int state, if (dpyinfo->x_focus_event_frame == frame) { dpyinfo->x_focus_event_frame = 0; - x_new_focus_frame (dpyinfo, 0); + pgtk_new_focus_frame (dpyinfo, NULL); bufp->ie.kind = FOCUS_OUT_EVENT; XSETFRAME (bufp->ie.frame_or_window, frame); @@ -5899,10 +5560,12 @@ enter_notify_event (GtkWidget *widget, GdkEvent *event, gpointer *user_data) { union buffered_input_event inev; - struct frame *frame = - pgtk_any_window_to_frame (gtk_widget_get_window (widget)); + struct frame *frame + = pgtk_any_window_to_frame (gtk_widget_get_window (widget)); + if (frame == NULL) return FALSE; + struct pgtk_display_info *dpyinfo = FRAME_DISPLAY_INFO (frame); struct frame *focus_frame = dpyinfo->x_focus_frame; int focus_state @@ -5914,7 +5577,7 @@ enter_notify_event (GtkWidget *widget, GdkEvent *event, if (event->crossing.detail != GDK_NOTIFY_INFERIOR && event->crossing.focus && !(focus_state & FOCUS_EXPLICIT)) - x_focus_changed (TRUE, FOCUS_IMPLICIT, dpyinfo, frame, &inev); + pgtk_focus_changed (TRUE, FOCUS_IMPLICIT, dpyinfo, frame, &inev); if (inev.ie.kind != NO_EVENT) evq_enqueue (&inev); return TRUE; @@ -5925,10 +5588,12 @@ leave_notify_event (GtkWidget *widget, GdkEvent *event, gpointer *user_data) { union buffered_input_event inev; - struct frame *frame = - pgtk_any_window_to_frame (gtk_widget_get_window (widget)); + struct frame *frame + = pgtk_any_window_to_frame (gtk_widget_get_window (widget)); + if (frame == NULL) return FALSE; + struct pgtk_display_info *dpyinfo = FRAME_DISPLAY_INFO (frame); struct frame *focus_frame = dpyinfo->x_focus_frame; int focus_state @@ -5949,7 +5614,7 @@ leave_notify_event (GtkWidget *widget, GdkEvent *event, if (event->crossing.detail != GDK_NOTIFY_INFERIOR && event->crossing.focus && !(focus_state & FOCUS_EXPLICIT)) - x_focus_changed (FALSE, FOCUS_IMPLICIT, dpyinfo, frame, &inev); + pgtk_focus_changed (FALSE, FOCUS_IMPLICIT, dpyinfo, frame, &inev); if (frame) { @@ -5968,11 +5633,11 @@ leave_notify_event (GtkWidget *widget, GdkEvent *event, } static gboolean -focus_in_event (GtkWidget * widget, GdkEvent * event, gpointer * user_data) +focus_in_event (GtkWidget *widget, GdkEvent *event, gpointer *user_data) { union buffered_input_event inev; - struct frame *frame = - pgtk_any_window_to_frame (gtk_widget_get_window (widget)); + struct frame *frame + = pgtk_any_window_to_frame (gtk_widget_get_window (widget)); if (frame == NULL) return TRUE; @@ -5981,8 +5646,8 @@ focus_in_event (GtkWidget * widget, GdkEvent * event, gpointer * user_data) inev.ie.kind = NO_EVENT; inev.ie.arg = Qnil; - x_focus_changed (TRUE, FOCUS_EXPLICIT, - FRAME_DISPLAY_INFO (frame), frame, &inev); + pgtk_focus_changed (TRUE, FOCUS_EXPLICIT, + FRAME_DISPLAY_INFO (frame), frame, &inev); if (inev.ie.kind != NO_EVENT) evq_enqueue (&inev); @@ -5992,11 +5657,11 @@ focus_in_event (GtkWidget * widget, GdkEvent * event, gpointer * user_data) } static gboolean -focus_out_event (GtkWidget * widget, GdkEvent * event, gpointer * user_data) +focus_out_event (GtkWidget *widget, GdkEvent *event, gpointer *user_data) { union buffered_input_event inev; - struct frame *frame = - pgtk_any_window_to_frame (gtk_widget_get_window (widget)); + struct frame *frame + = pgtk_any_window_to_frame (gtk_widget_get_window (widget)); if (frame == NULL) return TRUE; @@ -6005,8 +5670,8 @@ focus_out_event (GtkWidget * widget, GdkEvent * event, gpointer * user_data) inev.ie.kind = NO_EVENT; inev.ie.arg = Qnil; - x_focus_changed (FALSE, FOCUS_EXPLICIT, - FRAME_DISPLAY_INFO (frame), frame, &inev); + pgtk_focus_changed (FALSE, FOCUS_EXPLICIT, + FRAME_DISPLAY_INFO (frame), frame, &inev); if (inev.ie.kind != NO_EVENT) evq_enqueue (&inev); @@ -6074,17 +5739,14 @@ note_mouse_movement (struct frame *frame, } static gboolean -motion_notify_event (GtkWidget * widget, GdkEvent * event, - gpointer * user_data) +motion_notify_event (GtkWidget *widget, GdkEvent *event, + gpointer *user_data) { union buffered_input_event inev; struct frame *f, *frame; struct pgtk_display_info *dpyinfo; Mouse_HLInfo *hlinfo; - /* This is needed to make pointer visible when motion_notify event */ - pending_signals = true; - EVENT_INIT (inev.ie); inev.ie.kind = NO_EVENT; inev.ie.arg = Qnil; @@ -6106,6 +5768,7 @@ motion_notify_event (GtkWidget * widget, GdkEvent * event, if (f && xg_event_is_for_scrollbar (f, event, false)) f = 0; + if (f) { /* Maybe generate a SELECT_WINDOW_EVENT for @@ -6150,11 +5813,9 @@ motion_notify_event (GtkWidget * widget, GdkEvent * event, help_echo_string = previous_help_echo_string; } else - { - /* If we move outside the frame, then we're - certainly no longer on any text in the frame. */ - clear_mouse_face (hlinfo); - } + /* If we move outside the frame, then we're + certainly no longer on any text in the frame. */ + clear_mouse_face (hlinfo); /* If the contents of the global variable help_echo_string has changed, generate a HELP_EVENT. */ @@ -6793,9 +6454,6 @@ pgtk_term_init (Lisp_Object display_name, char *resource_name) *nametail++ = '@'; lispstpcpy (nametail, system_name); - /* Figure out which modifier bits mean what. */ - x_find_modifier_meanings (dpyinfo); - /* Get the scroll bar cursor. */ /* We must create a GTK cursor, it is required for GTK widgets. */ dpyinfo->xg_cursor = xg_create_default_cursor (dpyinfo->gdpy); @@ -7044,7 +6702,6 @@ pgtk_clear_area (struct frame *f, int x, int y, int width, int height) void syms_of_pgtkterm (void) { - /* from 23+ we need to tell emacs what modifiers there are.. */ DEFSYM (Qmodifier_value, "modifier-value"); DEFSYM (Qalt, "alt"); DEFSYM (Qhyper, "hyper"); @@ -7229,7 +6886,7 @@ pgtk_cr_draw_frame (cairo_t * cr, struct frame *f) static cairo_status_t pgtk_cr_accumulate_data (void *closure, const unsigned char *data, - unsigned int length) + unsigned int length) { Lisp_Object *acc = (Lisp_Object *) closure; @@ -7256,8 +6913,6 @@ pgtk_cr_destroy (void *cr) unblock_input (); } - - Lisp_Object pgtk_cr_export_frames (Lisp_Object frames, cairo_surface_type_t surface_type) { @@ -7351,7 +7006,6 @@ pgtk_cr_export_frames (Lisp_Object frames, cairo_surface_type_t surface_type) return CALLN (Fapply, intern ("concat"), Fnreverse (acc)); } - void init_pgtkterm (void) { diff --git a/src/pgtkterm.h b/src/pgtkterm.h index 56c5d22e54e..20c161e63b9 100644 --- a/src/pgtkterm.h +++ b/src/pgtkterm.h @@ -62,9 +62,9 @@ struct pgtk_device_t #define ARGB_TO_ULONG(a, r, g, b) (((a) << 24) | ((r) << 16) | ((g) << 8) | (b)) #define ALPHA_FROM_ULONG(color) ((color) >> 24) -#define RED_FROM_ULONG(color) (((color) >> 16) & 0xff) +#define RED_FROM_ULONG(color) (((color) >> 16) & 0xff) #define GREEN_FROM_ULONG(color) (((color) >> 8) & 0xff) -#define BLUE_FROM_ULONG(color) ((color) & 0xff) +#define BLUE_FROM_ULONG(color) ((color) & 0xff) struct scroll_bar { @@ -225,9 +225,6 @@ struct pgtk_display_info /* The frame where the mouse was last time we reported a mouse position. */ struct frame *last_mouse_glyph_frame; - /* Modifier masks in gdk */ - int meta_mod_mask, alt_mod_mask, super_mod_mask, hyper_mod_mask; - /* The last click event. */ GdkEvent *last_click_event; @@ -395,6 +392,10 @@ struct pgtk_output They are changed only when a different background is involved. */ unsigned long relief_background; + /* Whether or not a relief background has been computed for this + frame. */ + bool_bf relief_background_valid_p : 1; + /* Keep track of focus. May be EXPLICIT if we received a FocusIn for this frame, or IMPLICIT if we received an EnterNotify. FocusOut and LeaveNotify clears EXPLICIT/IMPLICIT. */ @@ -521,19 +522,14 @@ extern void pgtk_clear_under_internal_border (struct frame *f); extern void pgtk_set_event_handler (struct frame *f); /* Implemented in pgtkterm.c */ -extern int x_display_pixel_height (struct pgtk_display_info *); -extern int x_display_pixel_width (struct pgtk_display_info *); +extern int pgtk_display_pixel_height (struct pgtk_display_info *); +extern int pgtk_display_pixel_width (struct pgtk_display_info *); -/* Implemented in pgtkterm.c */ -extern void x_destroy_window (struct frame *f); -extern void x_set_parent_frame (struct frame *f, Lisp_Object new_value, - Lisp_Object old_value); -extern void x_set_no_focus_on_map (struct frame *f, Lisp_Object new_value, - Lisp_Object old_value); -extern void x_set_no_accept_focus (struct frame *f, Lisp_Object new_value, - Lisp_Object old_value); -extern void x_set_z_group (struct frame *f, Lisp_Object new_value, - Lisp_Object old_value); +extern void pgtk_destroy_window (struct frame *f); +extern void pgtk_set_parent_frame (struct frame *f, Lisp_Object, Lisp_Object); +extern void pgtk_set_no_focus_on_map (struct frame *, Lisp_Object, Lisp_Object); +extern void pgtk_set_no_accept_focus (struct frame *, Lisp_Object, Lisp_Object); +extern void pgtk_set_z_group (struct frame *, Lisp_Object, Lisp_Object); /* Cairo related functions implemented in pgtkterm.c */ extern void pgtk_cr_update_surface_desired_size (struct frame *, int, int, bool); @@ -569,17 +565,16 @@ extern void pgtk_delete_terminal (struct terminal *terminal); extern void pgtk_make_frame_visible (struct frame *f); extern void pgtk_make_frame_invisible (struct frame *f); -extern void x_wm_set_size_hint (struct frame *, long, bool); -extern void x_free_frame_resources (struct frame *); +extern void pgtk_free_frame_resources (struct frame *); extern void pgtk_iconify_frame (struct frame *f); extern void pgtk_focus_frame (struct frame *f, bool noactivate); extern void pgtk_set_scroll_bar_default_width (struct frame *f); extern void pgtk_set_scroll_bar_default_height (struct frame *f); -extern Lisp_Object x_get_focus_frame (struct frame *frame); +extern Lisp_Object pgtk_get_focus_frame (struct frame *frame); extern void pgtk_frame_rehighlight (struct pgtk_display_info *dpyinfo); -extern void x_change_tab_bar_height (struct frame *, int); +extern void pgtk_change_tab_bar_height (struct frame *, int); extern struct pgtk_display_info *check_pgtk_display_info (Lisp_Object object); diff --git a/src/print.c b/src/print.c index 4a68d15fe02..d7583282b69 100644 --- a/src/print.c +++ b/src/print.c @@ -768,6 +768,16 @@ is used instead. */) return object; } +DEFUN ("flush-standard-output", Fflush_standard_output, Sflush_standard_output, + 0, 0, 0, + doc: /* Flush standard-output. +This can be useful after using `princ' and the like in scripts. */) + (void) +{ + fflush (stdout); + return Qnil; +} + DEFUN ("external-debugging-output", Fexternal_debugging_output, Sexternal_debugging_output, 1, 1, 0, doc: /* Write CHARACTER to stderr. You can call `print' while debugging emacs, and pass it this function @@ -944,7 +954,14 @@ print_error_message (Lisp_Object data, Lisp_Object stream, const char *context, errmsg = Fget (errname, Qerror_message); /* During loadup 'substitute-command-keys' might not be available. */ if (!NILP (Ffboundp (Qsubstitute_command_keys))) - errmsg = call1 (Qsubstitute_command_keys, errmsg); + { + /* `substitute-command-keys' may bug out, which would lead + to infinite recursion when we're called from + skip_debugger, so ignore errors. */ + Lisp_Object subs = safe_call1 (Qsubstitute_command_keys, errmsg); + if (!NILP (subs)) + errmsg = subs; + } file_error = Fmemq (Qfile_error, error_conditions); } @@ -1691,10 +1708,10 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag, case PVEC_USER_PTR: { + void *finalizer = XUSER_PTR (obj)->finalizer; print_c_string ("#<user-ptr ", printcharfun); int i = sprintf (buf, "ptr=%p finalizer=%p", - XUSER_PTR (obj)->p, - XUSER_PTR (obj)->finalizer); + XUSER_PTR (obj)->p, finalizer); strout (buf, i, i, printcharfun); printchar ('>', printcharfun); } @@ -1865,7 +1882,8 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag, print_string (XTHREAD (obj)->name, printcharfun); else { - int len = sprintf (buf, "%p", XTHREAD (obj)); + void *p = XTHREAD (obj); + int len = sprintf (buf, "%p", p); strout (buf, len, len, printcharfun); } printchar ('>', printcharfun); @@ -1877,7 +1895,8 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag, print_string (XMUTEX (obj)->name, printcharfun); else { - int len = sprintf (buf, "%p", XMUTEX (obj)); + void *p = XMUTEX (obj); + int len = sprintf (buf, "%p", p); strout (buf, len, len, printcharfun); } printchar ('>', printcharfun); @@ -1889,7 +1908,8 @@ print_vectorlike (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag, print_string (XCONDVAR (obj)->name, printcharfun); else { - int len = sprintf (buf, "%p", XCONDVAR (obj)); + void *p = XCONDVAR (obj); + int len = sprintf (buf, "%p", p); strout (buf, len, len, printcharfun); } printchar ('>', printcharfun); @@ -2549,4 +2569,6 @@ printed. If the function returns anything else, the object will not be printed. */); Vprint_unreadable_function = Qnil; DEFSYM (Qprint_unreadable_function, "print-unreadable-function"); + + defsubr (&Sflush_standard_output); } diff --git a/src/sqlite.c b/src/sqlite.c index 1ca86699318..75a3b2ea32c 100644 --- a/src/sqlite.c +++ b/src/sqlite.c @@ -43,6 +43,8 @@ DEF_DLL_FN (SQLITE_API int, sqlite3_open_v2, DEF_DLL_FN (SQLITE_API int, sqlite3_reset, (sqlite3_stmt*)); DEF_DLL_FN (SQLITE_API int, sqlite3_bind_text, (sqlite3_stmt*, int, const char*, int, void(*)(void*))); +DEF_DLL_FN (SQLITE_API int, sqlite3_bind_blob, + (sqlite3_stmt*, int, const char*, int, void(*)(void*))); DEF_DLL_FN (SQLITE_API int, sqlite3_bind_int64, (sqlite3_stmt*, int, sqlite3_int64)); DEF_DLL_FN (SQLITE_API int, sqlite3_bind_double, (sqlite3_stmt*, int, double)); @@ -80,6 +82,7 @@ DEF_DLL_FN (SQLITE_API int, sqlite3_load_extension, # undef sqlite3_open_v2 # undef sqlite3_reset # undef sqlite3_bind_text +# undef sqlite3_bind_blob # undef sqlite3_bind_int64 # undef sqlite3_bind_double # undef sqlite3_bind_null @@ -103,6 +106,7 @@ DEF_DLL_FN (SQLITE_API int, sqlite3_load_extension, # define sqlite3_open_v2 fn_sqlite3_open_v2 # define sqlite3_reset fn_sqlite3_reset # define sqlite3_bind_text fn_sqlite3_bind_text +# define sqlite3_bind_blob fn_sqlite3_bind_blob # define sqlite3_bind_int64 fn_sqlite3_bind_int64 # define sqlite3_bind_double fn_sqlite3_bind_double # define sqlite3_bind_null fn_sqlite3_bind_null @@ -129,6 +133,7 @@ load_dll_functions (HMODULE library) LOAD_DLL_FN (library, sqlite3_open_v2); LOAD_DLL_FN (library, sqlite3_reset); LOAD_DLL_FN (library, sqlite3_bind_text); + LOAD_DLL_FN (library, sqlite3_bind_blob); LOAD_DLL_FN (library, sqlite3_bind_int64); LOAD_DLL_FN (library, sqlite3_bind_double); LOAD_DLL_FN (library, sqlite3_bind_null); @@ -240,38 +245,36 @@ DEFUN ("sqlite-open", Fsqlite_open, Ssqlite_open, 0, 1, 0, If FILE is nil, an in-memory database will be opened instead. */) (Lisp_Object file) { - char *name; + Lisp_Object name; + int flags = (SQLITE_OPEN_CREATE | SQLITE_OPEN_FULLMUTEX + | SQLITE_OPEN_READWRITE); +#ifdef SQLITE_OPEN_URI + flags |= SQLITE_OPEN_URI; +#endif + if (!init_sqlite_functions ()) xsignal1 (Qerror, build_string ("sqlite support is not available")); if (!NILP (file)) + name = ENCODE_FILE (Fexpand_file_name (file, Qnil)); + else { - CHECK_STRING (file); - file = ENCODE_FILE (Fexpand_file_name (file, Qnil)); - name = xstrdup (SSDATA (file)); +#ifdef SQLITE_OPEN_MEMORY + /* In-memory database. These have to have different names to + refer to different databases. */ + AUTO_STRING (memory_fmt, ":memory:%d"); + name = CALLN (Fformat, memory_fmt, make_int (++db_count)); + flags |= SQLITE_OPEN_MEMORY; +#else + xsignal1 (Qerror, build_string ("sqlite in-memory is not available")); +#endif } - else - /* In-memory database. These have to have different names to - refer to different databases. */ - name = xstrdup (SSDATA (CALLN (Fformat, build_string (":memory:%d"), - make_int (++db_count)))); sqlite3 *sdb; - int ret = sqlite3_open_v2 (name, - &sdb, - SQLITE_OPEN_FULLMUTEX - | SQLITE_OPEN_READWRITE - | SQLITE_OPEN_CREATE - | (NILP (file) ? SQLITE_OPEN_MEMORY : 0) -#ifdef SQLITE_OPEN_URI - | SQLITE_OPEN_URI -#endif - | 0, NULL); - - if (ret != SQLITE_OK) + if (sqlite3_open_v2 (SSDATA (name), &sdb, flags, NULL) != SQLITE_OK) return Qnil; - return make_sqlite (false, sdb, NULL, name); + return make_sqlite (false, sdb, NULL, xstrdup (SSDATA (name))); } DEFUN ("sqlite-close", Fsqlite_close, Ssqlite_close, 1, 1, 0, @@ -311,10 +314,37 @@ bind_values (sqlite3 *db, sqlite3_stmt *stmt, Lisp_Object values) if (EQ (type, Qstring)) { - Lisp_Object encoded = encode_string (value); - ret = sqlite3_bind_text (stmt, i + 1, - SSDATA (encoded), SBYTES (encoded), - NULL); + Lisp_Object encoded; + bool blob = false; + + if (SBYTES (value) == 0) + encoded = value; + else + { + Lisp_Object coding_system = + Fget_text_property (make_fixnum (0), Qcoding_system, value); + if (NILP (coding_system)) + /* Default to utf-8. */ + encoded = encode_string (value); + else if (EQ (coding_system, Qbinary)) + blob = true; + else + encoded = Fencode_coding_string (value, coding_system, + Qnil, Qnil); + } + + if (blob) + { + if (SBYTES (value) != SCHARS (value)) + xsignal1 (Qerror, build_string ("BLOB values must be unibyte")); + ret = sqlite3_bind_blob (stmt, i + 1, + SSDATA (value), SBYTES (value), + NULL); + } + else + ret = sqlite3_bind_text (stmt, i + 1, + SSDATA (encoded), SBYTES (encoded), + NULL); } else if (EQ (type, Qinteger)) { @@ -428,11 +458,8 @@ row_to_value (sqlite3_stmt *stmt) break; case SQLITE_BLOB: - v = - code_convert_string_norecord - (make_unibyte_string (sqlite3_column_blob (stmt, i), - sqlite3_column_bytes (stmt, i)), - Qutf_8, false); + v = make_unibyte_string (sqlite3_column_blob (stmt, i), + sqlite3_column_bytes (stmt, i)); break; case SQLITE_NULL: @@ -750,4 +777,6 @@ syms_of_sqlite (void) DEFSYM (Qfalse, "false"); DEFSYM (Qsqlite, "sqlite"); DEFSYM (Qsqlite3, "sqlite3"); + DEFSYM (Qbinary, "binary"); + DEFSYM (Qcoding_system, "coding-system"); } diff --git a/src/sysdep.c b/src/sysdep.c index 1632f46d13e..95295e7e676 100644 --- a/src/sysdep.c +++ b/src/sysdep.c @@ -2330,6 +2330,20 @@ emacs_fstatat (int dirfd, char const *filename, void *st, int flags) return r; } +static int +sys_openat (int dirfd, char const *file, int oflags, int mode) +{ +#ifdef O_PATH + return openat (dirfd, file, oflags, mode); +#else + /* On platforms without O_PATH, emacs_openat's callers arrange for + DIRFD to be AT_FDCWD, so it should be safe to just call 'open'. + This ports to old platforms like OS X 10.9 that lack openat. */ + eassert (dirfd == AT_FDCWD); + return open (file, oflags, mode); +#endif +} + /* Assuming the directory DIRFD, open FILE for Emacs use, using open flags OFLAGS and mode MODE. Use binary I/O on systems that care about text vs binary I/O. @@ -2345,7 +2359,7 @@ emacs_openat (int dirfd, char const *file, int oflags, int mode) if (! (oflags & O_TEXT)) oflags |= O_BINARY; oflags |= O_CLOEXEC; - while ((fd = openat (dirfd, file, oflags, mode)) < 0 && errno == EINTR) + while ((fd = sys_openat (dirfd, file, oflags, mode)) < 0 && errno == EINTR) maybe_quit (); return fd; } @@ -2358,26 +2372,19 @@ emacs_open (char const *file, int oflags, int mode) /* Same as above, but doesn't allow the user to quit. */ -static int -emacs_openat_noquit (int dirfd, const char *file, int oflags, - int mode) +int +emacs_open_noquit (char const *file, int oflags, int mode) { int fd; if (! (oflags & O_TEXT)) oflags |= O_BINARY; oflags |= O_CLOEXEC; do - fd = openat (dirfd, file, oflags, mode); + fd = open (file, oflags, mode); while (fd < 0 && errno == EINTR); return fd; } -int -emacs_open_noquit (char const *file, int oflags, int mode) -{ - return emacs_openat_noquit (AT_FDCWD, file, oflags, mode); -} - /* Open FILE as a stream for Emacs use, with mode MODE. Act like emacs_open with respect to threads, signals, and quits. */ @@ -3186,7 +3193,7 @@ make_lisp_timeval (struct timeval t) #endif -#ifdef GNU_LINUX +#if defined (GNU_LINUX) || defined (CYGWIN) static Lisp_Object time_from_jiffies (unsigned long long ticks, Lisp_Object hz, Lisp_Object form) @@ -3234,6 +3241,7 @@ get_up_time (void) return up; } +# ifdef GNU_LINUX #define MAJOR(d) (((unsigned)(d) >> 8) & 0xfff) #define MINOR(d) (((unsigned)(d) & 0xff) | (((unsigned)(d) & 0xfff00000) >> 12)) @@ -3279,6 +3287,7 @@ procfs_ttyname (int rdev) unblock_input (); return build_string (name); } +# endif /* GNU_LINUX */ static uintmax_t procfs_get_total_memory (void) @@ -3413,7 +3422,7 @@ system_process_attributes (Lisp_Object pid) utime stime cutime cstime priority nice thcount . start vsize rss */ if (q && (sscanf (q + 2, ("%c %d %d %d %d %d %*u %lu %lu %lu %lu " - "%Lu %Lu %Lu %Lu %ld %ld %d %*d %Lu %lu %ld"), + "%llu %llu %llu %llu %ld %ld %d %*d %llu %lu %ld"), &c, &ppid, &pgrp, &sess, &tty, &tpgid, &minflt, &cminflt, &majflt, &cmajflt, &u_time, &s_time, &cutime, &cstime, @@ -3427,7 +3436,9 @@ system_process_attributes (Lisp_Object pid) attrs = Fcons (Fcons (Qppid, INT_TO_INTEGER (ppid)), attrs); attrs = Fcons (Fcons (Qpgrp, INT_TO_INTEGER (pgrp)), attrs); attrs = Fcons (Fcons (Qsess, INT_TO_INTEGER (sess)), attrs); +# ifdef GNU_LINUX attrs = Fcons (Fcons (Qttname, procfs_ttyname (tty)), attrs); +# endif attrs = Fcons (Fcons (Qtpgid, INT_TO_INTEGER (tpgid)), attrs); attrs = Fcons (Fcons (Qminflt, INT_TO_INTEGER (minflt)), attrs); attrs = Fcons (Fcons (Qmajflt, INT_TO_INTEGER (majflt)), attrs); @@ -3476,6 +3487,26 @@ system_process_attributes (Lisp_Object pid) } unbind_to (count, Qnil); +# ifdef CYGWIN + /* ttname */ + strcpy (procfn_end, "/ctty"); + fd = emacs_open (fn, O_RDONLY, 0); + if (fd < 0) + nread = 0; + else + { + record_unwind_protect_int (close_file_unwind, fd); + nread = emacs_read_quit (fd, procbuf, sizeof procbuf); + } + /* /proc/<pid>/ctty should always end in newline. */ + if (0 < nread && procbuf[nread - 1] == '\n') + procbuf[nread - 1] = '\0'; + else + procbuf[0] = '\0'; + attrs = Fcons (Fcons (Qttname, build_string (procbuf)), attrs); + unbind_to (count, Qnil); +# endif /* CYGWIN */ + /* args */ strcpy (procfn_end, "/cmdline"); fd = emacs_open (fn, O_RDONLY, 0); @@ -4012,6 +4043,9 @@ system_process_attributes (Lisp_Object pid) #elif defined DARWIN_OS +#define HAVE_RUSAGE_INFO_CURRENT (__MAC_OS_X_VERSION_MIN_REQUIRED >= 101000) +#define HAVE_PROC_PIDINFO (__MAC_OS_X_VERSION_MIN_REQUIRED >= 1050) + Lisp_Object system_process_attributes (Lisp_Object pid) { @@ -4114,6 +4148,7 @@ system_process_attributes (Lisp_Object pid) attrs = Fcons (Fcons (Qtpgid, INT_TO_INTEGER (proc.kp_eproc.e_tpgid)), attrs); +#if HAVE_RUSAGE_INFO_CURRENT rusage_info_current ri; if (proc_pid_rusage(proc_id, RUSAGE_INFO_CURRENT, (rusage_info_t *) &ri) == 0) { @@ -4127,6 +4162,22 @@ system_process_attributes (Lisp_Object pid) attrs = Fcons (Fcons (Qmajflt, INT_TO_INTEGER (ri.ri_pageins)), attrs); } +#else /* !HAVE_RUSAGE_INFO_CURRENT */ + struct rusage *rusage = proc.kp_proc.p_ru; + if (rusage) + { + attrs = Fcons (Fcons (Qminflt, INT_TO_INTEGER (rusage->ru_minflt)), + attrs); + attrs = Fcons (Fcons (Qmajflt, INT_TO_INTEGER (rusage->ru_majflt)), + attrs); + + Lisp_Object utime = make_lisp_timeval (rusage->ru_utime); + Lisp_Object stime = make_lisp_timeval (rusage->ru_stime); + attrs = Fcons (Fcons (Qutime, utime), attrs); + attrs = Fcons (Fcons (Qstime, stime), attrs); + attrs = Fcons (Fcons (Qtime, Ftime_add (utime, stime)), attrs); + } +#endif /* !HAVE_RUSAGE_INFO_CURRENT */ starttime = proc.kp_proc.p_starttime; attrs = Fcons (Fcons (Qnice, make_fixnum (proc.kp_proc.p_nice)), attrs); @@ -4137,6 +4188,7 @@ system_process_attributes (Lisp_Object pid) Lisp_Object etime = Ftime_convert (Ftime_subtract (now, start), Qnil); attrs = Fcons (Fcons (Qetime, etime), attrs); +#if HAVE_PROC_PIDINFO struct proc_taskinfo taskinfo; if (proc_pidinfo (proc_id, PROC_PIDTASKINFO, 0, &taskinfo, sizeof (taskinfo)) > 0) { @@ -4144,6 +4196,7 @@ system_process_attributes (Lisp_Object pid) attrs = Fcons (Fcons (Qrss, make_fixnum (taskinfo.pti_resident_size / 1024)), attrs); attrs = Fcons (Fcons (Qthcount, make_fixnum (taskinfo.pti_threadnum)), attrs); } +#endif /* HAVE_PROC_PIDINFO */ #ifdef KERN_PROCARGS2 char args[ARG_MAX]; diff --git a/src/textprop.c b/src/textprop.c index c6c9e102e34..072aac28667 100644 --- a/src/textprop.c +++ b/src/textprop.c @@ -561,8 +561,13 @@ DEFUN ("text-properties-at", Ftext_properties_at, doc: /* Return the list of properties of the character at POSITION in OBJECT. If the optional second argument OBJECT is a buffer (or nil, which means the current buffer), POSITION is a buffer position (integer or marker). + If OBJECT is a string, POSITION is a 0-based index into it. -If POSITION is at the end of OBJECT, the value is nil. + +If POSITION is at the end of OBJECT, the value is nil, but note that +buffer narrowing does not affect the value. That is, if OBJECT is a +buffer or nil, and the buffer is narrowed and POSITION is at the end +of the narrowed buffer, the result may be non-nil. If you want to display the text properties at point in a human-readable form, use the `describe-text-properties' command. */) @@ -590,7 +595,11 @@ DEFUN ("get-text-property", Fget_text_property, Sget_text_property, 2, 3, 0, doc: /* Return the value of POSITION's property PROP, in OBJECT. OBJECT should be a buffer or a string; if omitted or nil, it defaults to the current buffer. -If POSITION is at the end of OBJECT, the value is nil. */) + +If POSITION is at the end of OBJECT, the value is nil, but note that +buffer narrowing does not affect the value. That is, if the buffer is +narrowed and POSITION is at the end of the narrowed buffer, the result +may be non-nil. */) (Lisp_Object position, Lisp_Object prop, Lisp_Object object) { return textget (Ftext_properties_at (position, object), prop); diff --git a/src/timefns.c b/src/timefns.c index 9e8592d35ac..7d2e3f64143 100644 --- a/src/timefns.c +++ b/src/timefns.c @@ -69,10 +69,9 @@ enum { TM_YEAR_BASE = 1900 }; # define FASTER_TIMEFNS 1 #endif -/* Although current-time etc. generate list-format timestamps - (HI LO US PS), the plan is to change these functions to generate - frequency-based timestamps (TICKS . HZ) in a future release. - To try this now, compile with -DCURRENT_TIME_LIST=0. */ +/* current-time-list defaults to t, typically generating (HI LO US PS) + timestamps. To change the default to nil, generating (TICKS . HZ) + timestamps, compile with -DCURRENT_TIME_LIST=0. */ #ifndef CURRENT_TIME_LIST enum { CURRENT_TIME_LIST = true }; #endif @@ -569,7 +568,7 @@ lisp_time_seconds (struct lisp_time t) Lisp_Object make_lisp_time (struct timespec t) { - if (CURRENT_TIME_LIST) + if (current_time_list) { time_t s = t.tv_sec; int ns = t.tv_nsec; @@ -1172,13 +1171,13 @@ time_arith (Lisp_Object a, Lisp_Object b, bool subtract) } /* Return an integer if the timestamp resolution is 1, - otherwise the (TICKS . HZ) form if !CURRENT_TIME_LIST or if + otherwise the (TICKS . HZ) form if !current_time_list or if either input used (TICKS . HZ) form or the result can't be expressed exactly in (HI LO US PS) form, otherwise the (HI LO US PS) form for backward compatibility. */ return (EQ (hz, make_fixnum (1)) ? ticks - : (!CURRENT_TIME_LIST + : (!current_time_list || aform == TIMEFORM_TICKS_HZ || bform == TIMEFORM_TICKS_HZ || !trillion_factor (hz)) @@ -1219,16 +1218,16 @@ time_cmp (Lisp_Object a, Lisp_Object b) return da < db ? -1 : da != db; } - struct lisp_time ta = lisp_time_struct (a, 0); - /* Compare nil to nil correctly, and handle other eq values quicker while we're at it. Compare here rather than earlier, to handle - NaNs and check formats. */ + NaNs. This means (time-equal-p X X) does not signal an error if + X is not a valid time value, but that's OK. */ if (EQ (a, b)) return 0; /* Compare (ATICKS . AZ) to (BTICKS . BHZ) by comparing ATICKS * BHZ to BTICKS * AHZ. */ + struct lisp_time ta = lisp_time_struct (a, 0); struct lisp_time tb = lisp_time_struct (b, 0); mpz_t const *za = bignum_integer (&mpz[0], ta.ticks); mpz_t const *zb = bignum_integer (&mpz[1], tb.ticks); @@ -1609,27 +1608,32 @@ check_tm_member (Lisp_Object obj, int offset) DEFUN ("encode-time", Fencode_time, Sencode_time, 1, MANY, 0, doc: /* Convert TIME to a timestamp. -TIME is a list (SECOND MINUTE HOUR DAY MONTH YEAR IGNORED DST ZONE). +TIME is a list (SECOND MINUTE HOUR DAY MONTH YEAR IGNORED DST ZONE) in the style of `decode-time', so that (encode-time (decode-time ...)) works. In this list, ZONE can be nil for Emacs local time, t for Universal Time, `wall' for system wall clock time, or a string as in the TZ -environment variable. It can also be a list (as from +environment variable. ZONE can also be a list (as from `current-time-zone') or an integer (as from `decode-time') applied without consideration for daylight saving time. If ZONE specifies a time zone with daylight-saving transitions, DST is t for daylight saving time, nil for standard time, and -1 to cause the daylight saving flag to be guessed. +TIME can also be a list (SECOND MINUTE HOUR DAY MONTH YEAR), which is +equivalent to (SECOND MINUTE HOUR DAY MONTH YEAR nil -1 nil). + As an obsolescent calling convention, if this function is called with 6 or more arguments, the first 6 arguments are SECOND, MINUTE, HOUR, DAY, MONTH, and YEAR, and specify the components of a decoded time. If there are more than 6 arguments the *last* argument is used as ZONE and any other extra arguments are ignored, so that (apply #\\='encode-time (decode-time ...)) works. In this obsolescent -convention, DST and ZONE default to -1 and nil respectively. +convention, DST is -1 and ZONE defaults to nil. -Years before 1970 are not guaranteed to work. On some systems, -year values as low as 1901 do work. +The range of supported years is at least 1970 to the near future. +Out-of-range values for SECOND through MONTH are brought into range +via date arithmetic. This can be tricky especially when combined with +DST; see Info node `(elisp)Time Conversion' for details and caveats. usage: (encode-time TIME &rest OBSOLESCENT-ARGUMENTS) */) (ptrdiff_t nargs, Lisp_Object *args) @@ -1643,7 +1647,7 @@ usage: (encode-time TIME &rest OBSOLESCENT-ARGUMENTS) */) if (nargs == 1) { Lisp_Object tail = a; - for (int i = 0; i < 9; i++, tail = XCDR (tail)) + for (int i = 0; i < 6; i++, tail = XCDR (tail)) CHECK_CONS (tail); secarg = XCAR (a); a = XCDR (a); minarg = XCAR (a); a = XCDR (a); @@ -1651,11 +1655,17 @@ usage: (encode-time TIME &rest OBSOLESCENT-ARGUMENTS) */) mdayarg = XCAR (a); a = XCDR (a); monarg = XCAR (a); a = XCDR (a); yeararg = XCAR (a); a = XCDR (a); - a = XCDR (a); - Lisp_Object dstflag = XCAR (a); a = XCDR (a); - zone = XCAR (a); - if (SYMBOLP (dstflag) && !FIXNUMP (zone) && !CONSP (zone)) - tm.tm_isdst = !NILP (dstflag); + if (! NILP (a)) + { + CHECK_CONS (a); + a = XCDR (a); + CHECK_CONS (a); + Lisp_Object dstflag = XCAR (a); a = XCDR (a); + CHECK_CONS (a); + zone = XCAR (a); + if (SYMBOLP (dstflag) && !FIXNUMP (zone) && !CONSP (zone)) + tm.tm_isdst = !NILP (dstflag); + } } else if (nargs < 6) xsignal2 (Qwrong_number_of_arguments, Qencode_time, make_fixnum (nargs)); @@ -1706,7 +1716,7 @@ usage: (encode-time TIME &rest OBSOLESCENT-ARGUMENTS) */) time_error (mktime_errno); if (EQ (hz, make_fixnum (1))) - return (CURRENT_TIME_LIST + return (current_time_list ? list2 (hi_time (value), lo_time (value)) : INT_TO_INTEGER (value)); else @@ -1737,7 +1747,7 @@ bits, and USEC and PSEC are the microsecond and picosecond counts. */) struct lisp_time t; enum timeform input_form = decode_lisp_time (time, false, &t, 0); if (NILP (form)) - form = CURRENT_TIME_LIST ? Qlist : Qt; + form = current_time_list ? Qlist : Qt; if (EQ (form, Qlist)) return ticks_hz_list4 (t.ticks, t.hz); if (EQ (form, Qinteger)) @@ -1752,20 +1762,32 @@ bits, and USEC and PSEC are the microsecond and picosecond counts. */) DEFUN ("current-time", Fcurrent_time, Scurrent_time, 0, 0, 0, doc: /* Return the current time, as the number of seconds since 1970-01-01 00:00:00. -The time is returned as a list of integers (HIGH LOW USEC PSEC). -HIGH has the most significant bits of the seconds, while LOW has the -least significant 16 bits. USEC and PSEC are the microsecond and -picosecond counts. - -In a future Emacs version, the format of the returned timestamp is -planned to change. Use `time-convert' if you need a particular -timestamp form; for example, (time-convert nil \\='integer) returns -the current time in seconds. */) +If the variable `current-time-list' is nil, the time is returned as a +pair of integers (TICKS . HZ), where TICKS counts clock ticks and HZ +is the clock ticks per second. Otherwise, the time is returned as a +list of integers (HIGH LOW USEC PSEC) where HIGH has the most +significant bits of the seconds, LOW has the least significant 16 +bits, and USEC and PSEC are the microsecond and picosecond counts. + +You can use `time-convert' to get a particular timestamp form +regardless of the value of `current-time-list'. */) (void) { return make_lisp_time (current_timespec ()); } +#ifdef CLOCKS_PER_SEC +DEFUN ("current-cpu-time", Fcurrent_cpu_time, Scurrent_cpu_time, 0, 0, 0, + doc: /* Return the current CPU time along with its resolution. +The return value is a pair (CPU-TICKS . TICKS-PER-SEC). +The CPU-TICKS counter can wrap around, so values cannot be meaningfully +compared if too much time has passed between them. */) + (void) +{ + return Fcons (make_int (clock ()), make_int (CLOCKS_PER_SEC)); +} +#endif + DEFUN ("current-time-string", Fcurrent_time_string, Scurrent_time_string, 0, 2, 0, doc: /* Return the current local time, as a human-readable string. @@ -2004,7 +2026,23 @@ syms_of_timefns (void) DEFSYM (Qencode_time, "encode-time"); + DEFVAR_BOOL ("current-time-list", current_time_list, + doc: /* Whether `current-time' should return list or (TICKS . HZ) form. + +This boolean variable is a transition aid. If t, `current-time' and +related functions return timestamps in list form, typically +\(HIGH LOW USEC PSEC); otherwise, they use (TICKS . HZ) form. +Currently this variable defaults to t, for behavior compatible with +previous Emacs versions. Developers are encouraged to test +timestamp-related code with this variable set to nil, as it will +default to nil in a future Emacs version, and will be removed in some +version after that. */); + current_time_list = CURRENT_TIME_LIST; + defsubr (&Scurrent_time); +#ifdef CLOCKS_PER_SEC + defsubr (&Scurrent_cpu_time); +#endif defsubr (&Stime_convert); defsubr (&Stime_add); defsubr (&Stime_subtract); diff --git a/src/w32.c b/src/w32.c index 0dc874eac40..1b10b9965fb 100644 --- a/src/w32.c +++ b/src/w32.c @@ -71,6 +71,8 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #undef localtime +#undef clock + char *sys_ctime (const time_t *); int sys_chdir (const char *); int sys_creat (const char *, int); @@ -87,6 +89,7 @@ struct tm *sys_localtime (const time_t *); compiler to emit a warning about sys_strerror having no prototype. */ char *sys_strerror (int); +clock_t sys_clock (void); #ifdef HAVE_MODULES extern void dynlib_reset_last_error (void); @@ -348,6 +351,7 @@ static BOOL g_b_init_reg_open_key_ex_w; static BOOL g_b_init_reg_query_value_ex_w; static BOOL g_b_init_expand_environment_strings_w; static BOOL g_b_init_get_user_default_ui_language; +static BOOL g_b_init_get_console_font_size; BOOL g_b_init_compare_string_w; BOOL g_b_init_debug_break_process; @@ -537,6 +541,22 @@ typedef LONG (WINAPI *RegQueryValueExW_Proc) (HKEY,LPCWSTR,LPDWORD,LPDWORD,LPBYT typedef DWORD (WINAPI *ExpandEnvironmentStringsW_Proc) (LPCWSTR,LPWSTR,DWORD); typedef LANGID (WINAPI *GetUserDefaultUILanguage_Proc) (void); +typedef COORD (WINAPI *GetConsoleFontSize_Proc) (HANDLE, DWORD); + +#if _WIN32_WINNT < 0x0501 +typedef struct +{ + DWORD nFont; + COORD dwFontSize; +} CONSOLE_FONT_INFO; +#endif + +typedef BOOL (WINAPI *GetCurrentConsoleFont_Proc) ( + HANDLE, + BOOL, + CONSOLE_FONT_INFO *); + + /* ** A utility function ** */ static BOOL is_windows_9x (void) @@ -4640,6 +4660,9 @@ sys_open (const char * path, int oflag, int mode) return res; } +/* This is not currently used, but might be needed again at some + point; DO NOT DELETE! */ +#if 0 int openat (int fd, const char * path, int oflag, int mode) { @@ -4660,6 +4683,7 @@ openat (int fd, const char * path, int oflag, int mode) return sys_open (path, oflag, mode); } +#endif int fchmod (int fd, mode_t mode) @@ -10134,6 +10158,32 @@ sys_localtime (const time_t *t) return localtime (t); } +/* The Windows CRT implementation of 'clock' doesn't really return CPU + time of the process (it returns the elapsed time since the process + started), so we provide a better emulation here, if possible. */ +clock_t +sys_clock (void) +{ + if (get_process_times_fn) + { + FILETIME create, exit, kernel, user; + HANDLE proc = GetCurrentProcess (); + if ((*get_process_times_fn) (proc, &create, &exit, &kernel, &user)) + { + LARGE_INTEGER user_int, kernel_int, total; + user_int.LowPart = user.dwLowDateTime; + user_int.HighPart = user.dwHighDateTime; + kernel_int.LowPart = kernel.dwLowDateTime; + kernel_int.HighPart = kernel.dwHighDateTime; + total.QuadPart = user_int.QuadPart + kernel_int.QuadPart; + /* We could redefine CLOCKS_PER_SEC to provide a finer + resolution, but with the basic 15.625 msec resolution of + the Windows clock, it doesn't really sound worth the hassle. */ + return total.QuadPart / (10000000 / CLOCKS_PER_SEC); + } + } + return clock (); +} /* Try loading LIBRARY_ID from the file(s) specified in @@ -10614,6 +10664,120 @@ realpath (const char *file_name, char *resolved_name) return xstrdup (tgt); } +static void +get_console_font_size (HANDLE hscreen, int *font_width, int *font_height) +{ + static GetCurrentConsoleFont_Proc s_pfn_Get_Current_Console_Font = NULL; + static GetConsoleFontSize_Proc s_pfn_Get_Console_Font_Size = NULL; + + /* Default guessed values, for when we cannot obtain the actual ones. */ + *font_width = 8; + *font_height = 12; + + if (!is_windows_9x ()) + { + if (g_b_init_get_console_font_size == 0) + { + HMODULE hm_kernel32 = LoadLibrary ("Kernel32.dll"); + if (hm_kernel32) + { + s_pfn_Get_Current_Console_Font = (GetCurrentConsoleFont_Proc) + get_proc_addr (hm_kernel32, "GetCurrentConsoleFont"); + s_pfn_Get_Console_Font_Size = (GetConsoleFontSize_Proc) + get_proc_addr (hm_kernel32, "GetConsoleFontSize"); + } + g_b_init_get_console_font_size = 1; + } + } + if (s_pfn_Get_Current_Console_Font && s_pfn_Get_Console_Font_Size) + { + CONSOLE_FONT_INFO font_info; + + if (s_pfn_Get_Current_Console_Font (hscreen, FALSE, &font_info)) + { + COORD font_size = s_pfn_Get_Console_Font_Size (hscreen, + font_info.nFont); + if (font_size.X > 0) + *font_width = font_size.X; + if (font_size.Y > 0) + *font_height = font_size.Y; + } + } +} + +/* A replacement for Posix execvp, used to restart Emacs. This is + needed because the low-level Windows API to start processes accepts + the command-line arguments as a single string, so we cannot safely + use the MSVCRT execvp emulation, because elements of argv[] that + have embedded blanks and tabs will not be passed correctly to the + restarted Emacs. */ +int +w32_reexec_emacs (char *cmd_line, const char *wdir) +{ + STARTUPINFO si; + BOOL status; + PROCESS_INFORMATION proc_info; + DWORD dwCreationFlags = NORMAL_PRIORITY_CLASS; + + GetStartupInfo (&si); /* Use the same startup info as the caller. */ + if (inhibit_window_system) + { + HANDLE screen_handle; + CONSOLE_SCREEN_BUFFER_INFO screen_info; + + screen_handle = GetStdHandle (STD_OUTPUT_HANDLE); + if (screen_handle != INVALID_HANDLE_VALUE + && GetConsoleScreenBufferInfo (screen_handle, &screen_info)) + { + int font_width, font_height; + + /* Make the restarted Emacs's console window the same + dimensions as ours. */ + si.dwXCountChars = screen_info.dwSize.X; + si.dwYCountChars = screen_info.dwSize.Y; + get_console_font_size (screen_handle, &font_width, &font_height); + si.dwXSize = + (screen_info.srWindow.Right - screen_info.srWindow.Left + 1) + * font_width; + si.dwYSize = + (screen_info.srWindow.Bottom - screen_info.srWindow.Top + 1) + * font_height; + si.dwFlags |= STARTF_USESIZE | STARTF_USECOUNTCHARS; + } + /* This is a kludge: it causes the restarted "emacs -nw" to have + a new console window created for it, and that new window + might have different (default) properties, not the ones of + the parent process's console window. But without this, + restarting Emacs in the -nw mode simply doesn't work, + probably because the parent's console is still in use. + FIXME! */ + dwCreationFlags = CREATE_NEW_CONSOLE; + } + + /* Make sure we are in the original directory, in case the command + line specifies the program as a relative file name. */ + chdir (wdir); + + status = CreateProcess (NULL, /* no program, take from command line */ + cmd_line, /* command line */ + NULL, + NULL, /* thread attributes */ + FALSE, /* unherit handles? */ + dwCreationFlags, + NULL, /* environment */ + wdir, /* initial directory */ + &si, /* startup info */ + &proc_info); + if (status) + { + CloseHandle (proc_info.hThread); + CloseHandle (proc_info.hProcess); + exit (0); + } + errno = ENOEXEC; + return -1; +} + /* globals_of_w32 is used to initialize those global variables that must always be initialized on startup even when the global variable @@ -10674,6 +10838,7 @@ globals_of_w32 (void) g_b_init_compare_string_w = 0; g_b_init_debug_break_process = 0; g_b_init_get_user_default_ui_language = 0; + g_b_init_get_console_font_size = 0; num_of_processors = 0; /* The following sets a handler for shutdown notifications for console apps. This actually applies to Emacs in both console and diff --git a/src/w32.h b/src/w32.h index 4941170bdcf..dc91c595c43 100644 --- a/src/w32.h +++ b/src/w32.h @@ -244,6 +244,9 @@ extern int w32_init_random (void *, ptrdiff_t); extern Lisp_Object w32_read_registry (HKEY, Lisp_Object, Lisp_Object); +/* Used instead of execvp to restart Emacs. */ +extern int w32_reexec_emacs (char *, const char *); + #ifdef HAVE_GNUTLS #include <gnutls/gnutls.h> diff --git a/src/w32console.c b/src/w32console.c index 12e1f397894..09749126e03 100644 --- a/src/w32console.c +++ b/src/w32console.c @@ -716,10 +716,10 @@ initialize_w32_display (struct terminal *term, int *width, int *height) if (cur_screen == INVALID_HANDLE_VALUE) { - printf ("CreateConsoleScreenBuffer failed in ResetTerm\n"); + printf ("CreateConsoleScreenBuffer failed in initialize_w32_display\n"); printf ("LastError = 0x%lx\n", GetLastError ()); fflush (stdout); - exit (0); + exit (1); } #else cur_screen = prev_screen; @@ -760,7 +760,13 @@ initialize_w32_display (struct terminal *term, int *width, int *height) } } - GetConsoleScreenBufferInfo (cur_screen, &info); + if (!GetConsoleScreenBufferInfo (cur_screen, &info)) + { + printf ("GetConsoleScreenBufferInfo failed in initialize_w32_display\n"); + printf ("LastError = 0x%lx\n", GetLastError ()); + fflush (stdout); + exit (1); + } char_attr_normal = info.wAttributes; diff --git a/src/w32fns.c b/src/w32fns.c index a880136d0ac..0f25c1a594a 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -1802,6 +1802,32 @@ w32_set_tool_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) w32_change_tool_bar_height (f, nlines * FRAME_LINE_HEIGHT (f)); } +/* Enable or disable double buffering on frame F. + + When double buffering is enabled, all drawing happens on a back + buffer (a bitmap), which is then displayed as a single operation + after redisplay is complete. This avoids flicker caused by the + results of an incomplete redisplay becoming visible. */ +static void +w32_set_inhibit_double_buffering (struct frame *f, + Lisp_Object new_value, + /* This parameter is unused. */ + Lisp_Object old_value) +{ + block_input (); + + if (NILP (new_value)) + FRAME_OUTPUT_DATA (f)->want_paint_buffer = 1; + else + { + FRAME_OUTPUT_DATA (f)->want_paint_buffer = 0; + w32_release_paint_buffer (f); + + SET_FRAME_GARBAGED (f); + } + + unblock_input (); +} /* Set the pixel height of the tool bar of frame F to HEIGHT. */ void @@ -4093,7 +4119,10 @@ w32_wnd_proc (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam) { case WM_ERASEBKGND: f = w32_window_to_frame (dpyinfo, hwnd); - if (f) + + enter_crit (); + if (f && (w32_disable_double_buffering + || !FRAME_OUTPUT_DATA (f)->paint_buffer)) { HDC hdc = get_frame_dc (f); GetUpdateRect (hwnd, &wmsg.rect, FALSE); @@ -4107,6 +4136,7 @@ w32_wnd_proc (HWND hwnd, UINT msg, WPARAM wParam, LPARAM lParam) wmsg.rect.right, wmsg.rect.bottom)); #endif /* W32_DEBUG_DISPLAY */ } + leave_crit (); return 1; case WM_PALETTECHANGED: /* ignore our own changes */ @@ -6080,6 +6110,10 @@ DEFUN ("x-create-frame", Fx_create_frame, Sx_create_frame, ? make_fixnum (0) : make_fixnum (1), NULL, NULL, RES_TYPE_NUMBER); + gui_default_parameter (f, parameters, Qinhibit_double_buffering, Qnil, + "inhibitDoubleBuffering", "InhibitDoubleBuffering", + RES_TYPE_BOOLEAN); + gui_default_parameter (f, parameters, Qbuffer_predicate, Qnil, "bufferPredicate", "BufferPredicate", RES_TYPE_SYMBOL); gui_default_parameter (f, parameters, Qtitle, Qnil, @@ -7096,6 +7130,9 @@ w32_create_tip_frame (struct w32_display_info *dpyinfo, Lisp_Object parms) "alpha", "Alpha", RES_TYPE_NUMBER); gui_default_parameter (f, parms, Qalpha_background, Qnil, "alphaBackground", "AlphaBackground", RES_TYPE_NUMBER); + gui_default_parameter (f, parms, Qinhibit_double_buffering, Qnil, + "inhibitDoubleBuffering", "InhibitDoubleBuffering", + RES_TYPE_BOOLEAN); /* Add `tooltip' frame parameter's default value. */ if (NILP (Fframe_parameter (frame, Qtooltip))) @@ -7329,9 +7366,8 @@ DEFUN ("x-show-tip", Fx_show_tip, Sx_show_tip, 1, 6, 0, decode_window_system_frame (frame); if (NILP (timeout)) - timeout = make_fixnum (5); - else - CHECK_FIXNAT (timeout); + timeout = Vx_show_tooltip_timeout; + CHECK_FIXNAT (timeout); if (NILP (dx)) dx = make_fixnum (5); @@ -10432,7 +10468,7 @@ frame_parm_handler w32_frame_parm_handlers[] = gui_set_alpha, 0, /* x_set_sticky */ 0, /* x_set_tool_bar_position */ - 0, /* x_set_inhibit_double_buffering */ + w32_set_inhibit_double_buffering, w32_set_undecorated, w32_set_parent_frame, w32_set_skip_taskbar, @@ -11207,6 +11243,12 @@ see `w32-ansi-code-page'. */); w32_multibyte_code_page = _getmbcp (); #endif + DEFVAR_BOOL ("w32-disable-double-buffering", w32_disable_double_buffering, + doc: /* Completely disable double buffering. +This variable is used for debugging, and takes precedence over any +value of the `inhibit-double-buffering' frame parameter. */); + w32_disable_double_buffering = false; + if (os_subtype == OS_SUBTYPE_NT) w32_unicode_gui = 1; else diff --git a/src/w32term.c b/src/w32term.c index 7837032304c..19786da3a6d 100644 --- a/src/w32term.c +++ b/src/w32term.c @@ -276,6 +276,62 @@ XGetGCValues (void *ignore, XGCValues *gc, #endif static void +w32_show_back_buffer (struct frame *f) +{ + struct w32_output *output; + HDC raw_dc; + + output = FRAME_OUTPUT_DATA (f); + + if (!output->want_paint_buffer || w32_disable_double_buffering) + return; + + enter_crit (); + + if (output->paint_buffer) + { + raw_dc = GetDC (output->window_desc); + + if (!raw_dc) + emacs_abort (); + + BitBlt (raw_dc, 0, 0, FRAME_PIXEL_WIDTH (f), + FRAME_PIXEL_HEIGHT (f), + output->paint_dc, 0, 0, SRCCOPY); + ReleaseDC (output->window_desc, raw_dc); + + output->paint_buffer_dirty = 0; + } + + leave_crit (); +} + +void +w32_release_paint_buffer (struct frame *f) +{ + /* Delete the back buffer so it gets created + again the next time we ask for the DC. */ + + enter_crit (); + if (FRAME_OUTPUT_DATA (f)->paint_buffer) + { + deselect_palette (f, FRAME_OUTPUT_DATA (f)->paint_buffer_handle); + + SelectObject (FRAME_OUTPUT_DATA (f)->paint_dc, + FRAME_OUTPUT_DATA (f)->paint_dc_object); + ReleaseDC (FRAME_OUTPUT_DATA (f)->window_desc, + FRAME_OUTPUT_DATA (f)->paint_buffer_handle); + DeleteDC (FRAME_OUTPUT_DATA (f)->paint_dc); + DeleteObject (FRAME_OUTPUT_DATA (f)->paint_buffer); + + FRAME_OUTPUT_DATA (f)->paint_buffer = NULL; + FRAME_OUTPUT_DATA (f)->paint_dc = NULL; + FRAME_OUTPUT_DATA (f)->paint_buffer_handle = NULL; + } + leave_crit (); +} + +static void w32_get_mouse_wheel_vertical_delta (void) { if (os_subtype != OS_SUBTYPE_NT) @@ -704,10 +760,32 @@ w32_update_end (struct frame *f) static void w32_frame_up_to_date (struct frame *f) { - if (FRAME_W32_P (f)) - FRAME_MOUSE_UPDATE (f); + FRAME_MOUSE_UPDATE (f); + + if (!buffer_flipping_blocked_p () + && FRAME_OUTPUT_DATA (f)->paint_buffer_dirty) + w32_show_back_buffer (f); } +static void +w32_buffer_flipping_unblocked_hook (struct frame *f) +{ + if (FRAME_OUTPUT_DATA (f)->paint_buffer_dirty) + w32_show_back_buffer (f); +} + +/* Flip buffers on F if drawing has happened. This function is not + called to flush the display connection of a frame (which doesn't + exist on MS Windows), but also called in some situations in + minibuf.c to make the contents of the back buffer visible. */ +void +w32_flip_buffers_if_dirty (struct frame *f) +{ + if (FRAME_OUTPUT_DATA (f)->paint_buffer + && FRAME_OUTPUT_DATA (f)->paint_buffer_dirty + && !f->garbaged && !buffer_flipping_blocked_p ()) + w32_show_back_buffer (f); +} /* Draw truncation mark bitmaps, continuation mark bitmaps, overlay arrow bitmaps, or clear the fringes if no bitmaps are required @@ -2872,8 +2950,9 @@ w32_scroll_run (struct window *w, struct run *run) { struct frame *f = XFRAME (w->frame); int x, y, width, height, from_y, to_y, bottom_y; + HDC hdc; HWND hwnd = FRAME_W32_WINDOW (f); - HRGN expect_dirty; + HRGN expect_dirty = NULL; /* Get frame-relative bounding box of the text display area of W, without mode lines. Include in this box the left and right @@ -2892,7 +2971,9 @@ w32_scroll_run (struct window *w, struct run *run) height = bottom_y - from_y; else height = run->height; - expect_dirty = CreateRectRgn (x, y + height, x + width, bottom_y); + + if (w32_disable_double_buffering) + expect_dirty = CreateRectRgn (x, y + height, x + width, bottom_y); } else { @@ -2902,44 +2983,55 @@ w32_scroll_run (struct window *w, struct run *run) height = bottom_y - to_y; else height = run->height; - expect_dirty = CreateRectRgn (x, y, x + width, to_y); + + if (w32_disable_double_buffering) + expect_dirty = CreateRectRgn (x, y, x + width, to_y); } block_input (); /* Cursor off. Will be switched on again in gui_update_window_end. */ gui_clear_cursor (w); - - { - RECT from; - RECT to; - HRGN dirty = CreateRectRgn (0, 0, 0, 0); - HRGN combined = CreateRectRgn (0, 0, 0, 0); - - from.left = to.left = x; - from.right = to.right = x + width; - from.top = from_y; - from.bottom = from_y + height; - to.top = y; - to.bottom = bottom_y; - - ScrollWindowEx (hwnd, 0, to_y - from_y, &from, &to, dirty, - NULL, SW_INVALIDATE); - - /* Combine this with what we expect to be dirty. This covers the - case where not all of the region we expect is actually dirty. */ - CombineRgn (combined, dirty, expect_dirty, RGN_OR); - - /* If the dirty region is not what we expected, redraw the entire frame. */ - if (!EqualRgn (combined, expect_dirty)) - SET_FRAME_GARBAGED (f); - - DeleteObject (dirty); - DeleteObject (combined); - } + if (!w32_disable_double_buffering) + { + hdc = get_frame_dc (f); + BitBlt (hdc, x, to_y, width, height, hdc, x, from_y, SRCCOPY); + release_frame_dc (f, hdc); + } + else + { + RECT from; + RECT to; + HRGN dirty = CreateRectRgn (0, 0, 0, 0); + HRGN combined = CreateRectRgn (0, 0, 0, 0); + + from.left = to.left = x; + from.right = to.right = x + width; + from.top = from_y; + from.bottom = from_y + height; + to.top = y; + to.bottom = bottom_y; + + ScrollWindowEx (hwnd, 0, to_y - from_y, &from, &to, dirty, + NULL, SW_INVALIDATE); + + /* Combine this with what we expect to be dirty. This covers the + case where not all of the region we expect is actually dirty. */ + CombineRgn (combined, dirty, expect_dirty, RGN_OR); + + /* If the dirty region is not what we expected, redraw the entire frame. */ + if (!EqualRgn (combined, expect_dirty)) + SET_FRAME_GARBAGED (f); + + DeleteObject (dirty); + DeleteObject (combined); + } unblock_input (); - DeleteObject (expect_dirty); + + if (w32_disable_double_buffering + && expect_dirty) + DeleteObject (expect_dirty); } @@ -4809,6 +4901,14 @@ w32_scroll_bar_clear (struct frame *f) { Lisp_Object bar; + /* Return if double buffering is enabled, since clearing a frame + actually clears just the back buffer, so avoid clearing all of + the scroll bars, since that causes the scroll bars to + flicker. */ + if (!w32_disable_double_buffering + && FRAME_OUTPUT_DATA (f)->want_paint_buffer) + return; + /* We can have scroll bars even if this is 0, if we just turned off scroll bar mode. But in that case we should not clear them. */ @@ -4924,10 +5024,17 @@ w32_read_socket (struct terminal *terminal, struct input_event inev; int do_help = 0; + /* WM_WINDOWPOSCHANGED makes the buffer dirty, but there's no + reason to flush the back buffer after receiving such an + event, and that also causes flicker. */ + bool ignore_dirty_back_buffer = false; + /* DebPrint (("w32_read_socket: %s time:%u\n", */ /* w32_name_of_message (msg.msg.message), */ /* msg.msg.time)); */ + f = NULL; + EVENT_INIT (inev); inev.kind = NO_EVENT; inev.arg = Qnil; @@ -4969,24 +5076,32 @@ w32_read_socket (struct terminal *terminal, } else { - /* Erase background again for safety. But don't do - that if the frame's 'garbaged' flag is set, since - in that case expose_frame will do nothing, and if - the various redisplay flags happen to be unset, - we are left with a blank frame. */ - if (!FRAME_GARBAGED_P (f) || FRAME_PARENT_FRAME (f)) + if (w32_disable_double_buffering + || !FRAME_OUTPUT_DATA (f)->paint_buffer) { - HDC hdc = get_frame_dc (f); - - w32_clear_rect (f, hdc, &msg.rect); - release_frame_dc (f, hdc); + /* Erase background again for safety. But don't do + that if the frame's 'garbaged' flag is set, since + in that case expose_frame will do nothing, and if + the various redisplay flags happen to be unset, + we are left with a blank frame. */ + + if (!FRAME_GARBAGED_P (f) || FRAME_PARENT_FRAME (f)) + { + HDC hdc = get_frame_dc (f); + + w32_clear_rect (f, hdc, &msg.rect); + release_frame_dc (f, hdc); + } + + expose_frame (f, + msg.rect.left, + msg.rect.top, + msg.rect.right - msg.rect.left, + msg.rect.bottom - msg.rect.top); + w32_clear_under_internal_border (f); } - expose_frame (f, - msg.rect.left, - msg.rect.top, - msg.rect.right - msg.rect.left, - msg.rect.bottom - msg.rect.top); - w32_clear_under_internal_border (f); + else + w32_show_back_buffer (f); } } break; @@ -5320,7 +5435,18 @@ w32_read_socket (struct terminal *terminal, window = window_from_coordinates (f, x, y, 0, 1, 1); - if (EQ (window, f->tool_bar_window)) + if (EQ (window, f->tool_bar_window) + /* Make sure the tool bar was previously + pressed, otherwise an event that started + outside of the tool bar will not be handled + correctly when the mouse button is + released. For example, start dragging to + select some buffer text, drag the mouse to + the tool bar, and release the mouse button + -- this should not consider the release + event as a tool-bar click. */ + && (inev.modifiers & down_modifier + || f->last_tool_bar_item != -1)) { w32_handle_tool_bar_click (f, &inev); tool_bar_p = 1; @@ -5437,6 +5563,7 @@ w32_read_socket (struct terminal *terminal, case WM_WINDOWPOSCHANGED: f = w32_window_to_frame (dpyinfo, msg.msg.hwnd); + ignore_dirty_back_buffer = true; if (f) { @@ -5659,6 +5786,8 @@ w32_read_socket (struct terminal *terminal, if (width != FRAME_PIXEL_WIDTH (f) || height != FRAME_PIXEL_HEIGHT (f)) { + w32_release_paint_buffer (f); + change_frame_size (f, width, height, false, true, false); SET_FRAME_GARBAGED (f); @@ -5840,6 +5969,15 @@ w32_read_socket (struct terminal *terminal, } count++; } + + /* Event processing might have drawn to F outside redisplay. If + that is the case, flush any changes that have been made to + the front buffer. */ + + if (f && !w32_disable_double_buffering + && FRAME_OUTPUT_DATA (f)->paint_buffer_dirty + && !f->garbaged && !ignore_dirty_back_buffer) + w32_show_back_buffer (f); } /* If the focus was just given to an autoraising frame, @@ -7054,6 +7192,9 @@ w32_free_frame_resources (struct frame *f) face. */ free_frame_faces (f); + /* Now release the back buffer if any exists. */ + w32_release_paint_buffer (f); + if (FRAME_W32_WINDOW (f)) my_destroy_window (f, FRAME_W32_WINDOW (f)); @@ -7350,6 +7491,7 @@ w32_create_terminal (struct w32_display_info *dpyinfo) terminal->update_end_hook = w32_update_end; terminal->read_socket_hook = w32_read_socket; terminal->frame_up_to_date_hook = w32_frame_up_to_date; + terminal->buffer_flipping_unblocked_hook = w32_buffer_flipping_unblocked_hook; terminal->defined_color_hook = w32_defined_color; terminal->query_frame_background_color = w32_query_frame_background_color; terminal->query_colors = w32_query_colors; @@ -7505,6 +7647,7 @@ w32_delete_display (struct w32_display_info *dpyinfo) if (dpyinfo->palette) DeleteObject (dpyinfo->palette); } + w32_reset_fringes (); } diff --git a/src/w32term.h b/src/w32term.h index 6c48323651f..88b7ec22bd1 100644 --- a/src/w32term.h +++ b/src/w32term.h @@ -412,6 +412,27 @@ struct w32_output geometry when 'fullscreen' is reset to nil. */ WINDOWPLACEMENT normal_placement; int prev_fsmode; + + /* The back buffer if there is an ongoing double-buffered drawing + operation. */ + HBITMAP paint_buffer; + + /* The handle of the back buffer and a DC that ought to be released + alongside the back buffer. */ + HDC paint_dc, paint_buffer_handle; + + /* The object previously selected into `paint_dc'. */ + HGDIOBJ paint_dc_object; + + /* The width and height of `paint_buffer'. */ + int paint_buffer_width, paint_buffer_height; + + /* Whether or not some painting was done to this window that has not + yet been drawn. */ + unsigned paint_buffer_dirty : 1; + + /* Whether or not this frame should be double buffered. */ + unsigned want_paint_buffer : 1; }; extern struct w32_output w32term_display; @@ -876,6 +897,8 @@ typedef char guichar_t; extern Lisp_Object w32_popup_dialog (struct frame *, Lisp_Object, Lisp_Object); extern void w32_arrow_cursor (void); +extern void w32_release_paint_buffer (struct frame *); +extern void w32_flip_buffers_if_dirty (struct frame *); extern void syms_of_w32term (void); extern void syms_of_w32menu (void); diff --git a/src/w32xfns.c b/src/w32xfns.c index d5974b906e8..22d39ae0037 100644 --- a/src/w32xfns.c +++ b/src/w32xfns.c @@ -136,13 +136,13 @@ select_palette (struct frame *f, HDC hdc) f->output_data.w32->old_palette = NULL; if (RealizePalette (hdc) != GDI_ERROR) - { - Lisp_Object frame, framelist; - FOR_EACH_FRAME (framelist, frame) { - SET_FRAME_GARBAGED (XFRAME (frame)); + Lisp_Object frame, framelist; + FOR_EACH_FRAME (framelist, frame) + { + SET_FRAME_GARBAGED (XFRAME (frame)); + } } - } } void @@ -157,19 +157,70 @@ deselect_palette (struct frame *f, HDC hdc) HDC get_frame_dc (struct frame *f) { - HDC hdc; + HDC hdc, paint_dc; + HBITMAP back_buffer; + HGDIOBJ obj; + struct w32_output *output; if (f->output_method != output_w32) emacs_abort (); enter_crit (); + output = FRAME_OUTPUT_DATA (f); + + if (output->paint_dc) + { + if (output->paint_buffer_width != FRAME_PIXEL_WIDTH (f) + || output->paint_buffer_height != FRAME_PIXEL_HEIGHT (f) + || w32_disable_double_buffering) + w32_release_paint_buffer (f); + else + { + output->paint_buffer_dirty = 1; + return output->paint_dc; + } + } - hdc = GetDC (f->output_data.w32->window_desc); + hdc = GetDC (output->window_desc); /* If this gets called during startup before the frame is valid, there is a chance of corrupting random data or crashing. */ if (hdc) - select_palette (f, hdc); + { + select_palette (f, hdc); + + if (!w32_disable_double_buffering + && FRAME_OUTPUT_DATA (f)->want_paint_buffer) + { + back_buffer + = CreateCompatibleBitmap (hdc, FRAME_PIXEL_WIDTH (f), + FRAME_PIXEL_HEIGHT (f)); + + if (back_buffer) + { + paint_dc = CreateCompatibleDC (hdc); + + if (!paint_dc) + DeleteObject (back_buffer); + else + { + obj = SelectObject (paint_dc, back_buffer); + + output->paint_dc_object = obj; + output->paint_dc = paint_dc; + output->paint_buffer_handle = hdc; + output->paint_buffer = back_buffer; + output->paint_buffer_width = FRAME_PIXEL_WIDTH (f); + output->paint_buffer_height = FRAME_PIXEL_HEIGHT (f); + output->paint_buffer_dirty = 1; + + SET_FRAME_GARBAGED (f); + + return paint_dc; + } + } + } + } return hdc; } @@ -179,8 +230,15 @@ release_frame_dc (struct frame *f, HDC hdc) { int ret; - deselect_palette (f, hdc); - ret = ReleaseDC (f->output_data.w32->window_desc, hdc); + /* Avoid releasing the double-buffered DC here, since it'll be + released upon the next buffer flip instead. */ + if (hdc != FRAME_OUTPUT_DATA (f)->paint_dc) + { + deselect_palette (f, hdc); + ret = ReleaseDC (f->output_data.w32->window_desc, hdc); + } + else + ret = 0; leave_crit (); diff --git a/src/widget.c b/src/widget.c index 4231aa71b53..b125b4caeed 100644 --- a/src/widget.c +++ b/src/widget.c @@ -42,11 +42,13 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <X11/ShellP.h> #include "../lwlib/lwlib.h" -static void EmacsFrameInitialize (Widget request, Widget new, ArgList dum1, Cardinal *dum2); -static void EmacsFrameDestroy (Widget widget); -static void EmacsFrameRealize (Widget widget, XtValueMask *mask, XSetWindowAttributes *attrs); -static void EmacsFrameResize (Widget widget); -static XtGeometryResult EmacsFrameQueryGeometry (Widget widget, XtWidgetGeometry *request, XtWidgetGeometry *result); +static void EmacsFrameInitialize (Widget, Widget, ArgList, Cardinal *); +static void EmacsFrameDestroy (Widget); +static void EmacsFrameRealize (Widget, XtValueMask *, XSetWindowAttributes *); +static void EmacsFrameResize (Widget); +static void EmacsFrameExpose (Widget, XEvent *, Region); +static XtGeometryResult EmacsFrameQueryGeometry (Widget, XtWidgetGeometry *, + XtWidgetGeometry *); #define offset(field) offsetof (EmacsFrameRec, emacs_frame.field) @@ -118,12 +120,12 @@ static EmacsFrameClassRec emacsFrameClassRec = { /* resource_count */ XtNumber (resources), /* xrm_class */ NULLQUARK, /* compress_motion */ TRUE, - /* compress_exposure */ TRUE, + /* compress_exposure */ XtExposeNoCompress, /* compress_enterleave */ TRUE, /* visible_interest */ FALSE, /* destroy */ EmacsFrameDestroy, /* resize */ EmacsFrameResize, - /* expose */ XtInheritExpose, + /* expose */ EmacsFrameExpose, /* Emacs never does XtSetvalues on this widget, so we have no code for it. */ @@ -156,33 +158,41 @@ static void get_default_char_pixel_size (EmacsFrame ew, int *pixel_width, int *pixel_height) { struct frame *f = ew->emacs_frame.frame; + *pixel_width = FRAME_COLUMN_WIDTH (f); *pixel_height = FRAME_LINE_HEIGHT (f); } static void -pixel_to_char_size (EmacsFrame ew, Dimension pixel_width, Dimension pixel_height, int *char_width, int *char_height) +pixel_to_char_size (EmacsFrame ew, Dimension pixel_width, + Dimension pixel_height, int *char_width, int *char_height) { struct frame *f = ew->emacs_frame.frame; + *char_width = FRAME_PIXEL_WIDTH_TO_TEXT_COLS (f, (int) pixel_width); *char_height = FRAME_PIXEL_HEIGHT_TO_TEXT_LINES (f, (int) pixel_height); } static void -char_to_pixel_size (EmacsFrame ew, int char_width, int char_height, Dimension *pixel_width, Dimension *pixel_height) +char_to_pixel_size (EmacsFrame ew, int char_width, int char_height, + Dimension *pixel_width, Dimension *pixel_height) { struct frame *f = ew->emacs_frame.frame; + *pixel_width = FRAME_TEXT_COLS_TO_PIXEL_WIDTH (f, char_width); *pixel_height = FRAME_TEXT_LINES_TO_PIXEL_HEIGHT (f, char_height); } static void -round_size_to_char (EmacsFrame ew, Dimension in_width, Dimension in_height, Dimension *out_width, Dimension *out_height) +round_size_to_char (EmacsFrame ew, Dimension in_width, Dimension in_height, + Dimension *out_width, Dimension *out_height) { int char_width; int char_height; - pixel_to_char_size (ew, in_width, in_height, &char_width, &char_height); - char_to_pixel_size (ew, char_width, char_height, out_width, out_height); + pixel_to_char_size (ew, in_width, in_height, + &char_width, &char_height); + char_to_pixel_size (ew, char_width, char_height, + out_width, out_height); } static Widget @@ -334,7 +344,8 @@ update_from_various_frame_slots (EmacsFrame ew) } static void -EmacsFrameInitialize (Widget request, Widget new, ArgList dum1, Cardinal *dum2) +EmacsFrameInitialize (Widget request, Widget new, + ArgList dum1, Cardinal *dum2) { EmacsFrame ew = (EmacsFrame) new; @@ -359,7 +370,8 @@ resize_cb (Widget widget, static void -EmacsFrameRealize (Widget widget, XtValueMask *mask, XSetWindowAttributes *attrs) +EmacsFrameRealize (Widget widget, XtValueMask *mask, + XSetWindowAttributes *attrs) { EmacsFrame ew = (EmacsFrame) widget; struct frame *f = ew->emacs_frame.frame; @@ -404,7 +416,8 @@ EmacsFrameResize (Widget widget) ew->core.width, ew->core.height, f->new_width, f->new_height); - change_frame_size (f, ew->core.width, ew->core.height, false, true, false); + change_frame_size (f, ew->core.width, ew->core.height, + false, true, false); if (get_wm_shell (widget)) update_wm_hints (get_wm_shell (widget), ew); @@ -462,6 +475,17 @@ EmacsFrameSetCharSize (Widget widget, int columns, int rows) rows * FRAME_LINE_HEIGHT (f)); } +static void +EmacsFrameExpose (Widget widget, XEvent *event, Region region) +{ + EmacsFrame ew = (EmacsFrame) widget; + struct frame *f = ew->emacs_frame.frame; + + expose_frame (f, event->xexpose.x, event->xexpose.y, + event->xexpose.width, event->xexpose.height); + flush_frame (f); +} + void widget_store_internal_border (Widget widget) diff --git a/src/window.c b/src/window.c index aed698d2a37..6d28384eeb7 100644 --- a/src/window.c +++ b/src/window.c @@ -1079,7 +1079,9 @@ means that if a column at the right of the text area is only partially visible, that column is not counted. Note that the returned value includes the column reserved for the -continuation glyph. */) +continuation glyph. + +Also see `window-max-characters-per-line'. */) (Lisp_Object window, Lisp_Object pixelwise) { return make_fixnum (window_body_width (decode_live_window (window), @@ -1692,6 +1694,14 @@ column 0. */) 0, false, false); } +ptrdiff_t +window_point (struct window *w) +{ + return (w == XWINDOW (selected_window) + ? BUF_PT (XBUFFER (w->contents)) + : XMARKER (w->pointm)->charpos); +} + DEFUN ("window-point", Fwindow_point, Swindow_point, 0, 1, 0, doc: /* Return current value of point in WINDOW. WINDOW must be a live window and defaults to the selected one. @@ -1705,12 +1715,7 @@ correct to return the top-level value of `point', outside of any `save-excursion' forms. But that is hard to define. */) (Lisp_Object window) { - register struct window *w = decode_live_window (window); - - if (w == XWINDOW (selected_window)) - return make_fixnum (BUF_PT (XBUFFER (w->contents))); - else - return Fmarker_position (w->pointm); + return make_fixnum (window_point (decode_live_window (window))); } DEFUN ("window-old-point", Fwindow_old_point, Swindow_old_point, 0, 1, 0, @@ -1852,8 +1857,13 @@ Return POS. */) DEFUN ("set-window-start", Fset_window_start, Sset_window_start, 2, 3, 0, doc: /* Make display in WINDOW start at position POS in WINDOW's buffer. WINDOW must be a live window and defaults to the selected one. Return -POS. Optional third arg NOFORCE non-nil inhibits next redisplay from -overriding motion of point in order to display at this exact start. +POS. + +Optional third arg NOFORCE non-nil prevents next redisplay from +moving point if displaying the window at POS makes point invisible; +redisplay will then choose the WINDOW's start position by itself in +that case, i.e. it will disregard POS if adhering to it will make +point not visible in the window. For reliable setting of WINDOW start position, make sure point is at a position that will be visible when that start is in effect, @@ -6324,36 +6334,6 @@ followed by all visible frames on the current terminal. */) return window; } -DEFUN ("scroll-other-window", Fscroll_other_window, Sscroll_other_window, 0, 1, "P", - doc: /* Scroll next window upward ARG lines; or near full screen if no ARG. -A near full screen is `next-screen-context-lines' less than a full screen. -Negative ARG means scroll downward. If ARG is the atom `-', scroll -downward by nearly full screen. When calling from a program, supply -as argument a number, nil, or `-'. - -The next window is usually the one below the current one; -or the one at the top if the current one is at the bottom. -It is determined by the function `other-window-for-scrolling', -which see. - -Also see the `other-window-scroll-default' variable. */) - (Lisp_Object arg) -{ - specpdl_ref count = SPECPDL_INDEX (); - scroll_command (Fother_window_for_scrolling (), arg, 1); - return unbind_to (count, Qnil); -} - -DEFUN ("scroll-other-window-down", Fscroll_other_window_down, - Sscroll_other_window_down, 0, 1, "P", - doc: /* Scroll next window downward ARG lines; or near full screen if no ARG. -For more details, see the documentation for `scroll-other-window'. */) - (Lisp_Object arg) -{ - specpdl_ref count = SPECPDL_INDEX (); - scroll_command (Fother_window_for_scrolling (), arg, -1); - return unbind_to (count, Qnil); -} DEFUN ("scroll-left", Fscroll_left, Sscroll_left, 0, 2, "^P\np", doc: /* Scroll selected window display ARG columns left. @@ -8333,7 +8313,10 @@ In this case the window is passed as argument. Functions specified by the default value are called for each frame if at least one window on that frame has been added or changed its buffer or its total or body size since the last redisplay. In this case the -frame is passed as argument. */); +frame is passed as argument. + +For instance, to hide the title bar when the frame is maximized, you +can add `frame-hide-title-bar-when-maximized' to this variable. */); Vwindow_size_change_functions = Qnil; DEFVAR_LISP ("window-selection-change-functions", Vwindow_selection_change_functions, @@ -8595,8 +8578,6 @@ displayed after a scrolling operation to be somewhat inaccurate. */); defsubr (&Sscroll_left); defsubr (&Sscroll_right); defsubr (&Sother_window_for_scrolling); - defsubr (&Sscroll_other_window); - defsubr (&Sscroll_other_window_down); defsubr (&Sminibuffer_selected_window); defsubr (&Srecenter); defsubr (&Swindow_text_width); diff --git a/src/window.h b/src/window.h index 94c9b7124f3..387a3be36a9 100644 --- a/src/window.h +++ b/src/window.h @@ -1191,6 +1191,7 @@ extern void replace_buffer_in_windows_safely (Lisp_Object); /* This looks like a setter, but it is a bit special. */ extern void wset_buffer (struct window *, Lisp_Object); extern bool window_outdated (struct window *); +extern ptrdiff_t window_point (struct window *w); extern void init_window_once (void); extern void init_window (void); extern void syms_of_window (void); diff --git a/src/xdisp.c b/src/xdisp.c index 6a0d0ea879a..50efa50c55b 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -770,7 +770,7 @@ static bool message_buf_print; static bool message_cleared_p; /* A scratch glyph row with contents used for generating truncation - glyphs. Also used in direct_output_for_insert. */ + glyphs and overlay-arrow glyphs. */ #define MAX_SCRATCH_GLYPHS 100 static struct glyph_row scratch_glyph_row; @@ -9910,6 +9910,18 @@ move_it_in_display_line_to (struct it *it, } else result = MOVE_NEWLINE_OR_CR; + /* If lines are truncated, and the line we moved across is + completely hscrolled out of view, reset the line metrics + to those of the newline we've just processed, so that + glyphs not on display don't affect the line's height. */ + if (it->line_wrap == TRUNCATE + && it->current_x <= it->first_visible_x + && result == MOVE_NEWLINE_OR_CR + && it->char_to_display == '\n') + { + it->max_ascent = it->ascent; + it->max_descent = it->descent; + } /* If we've processed the newline, make sure this flag is reset, as it must only be set when the newline itself is processed. */ @@ -12131,7 +12143,7 @@ setup_echo_area_for_printing (bool multibyte_p) { /* If we can't find an echo area any more, exit. */ if (! FRAME_LIVE_P (XFRAME (selected_frame))) - Fkill_emacs (Qnil); + Fkill_emacs (Qnil, Qnil); ensure_echo_area_buffers (); @@ -12669,18 +12681,23 @@ set_message_1 (void *a1, Lisp_Object string) void clear_message (bool current_p, bool last_displayed_p) { + Lisp_Object preserve = Qnil; + if (current_p) { - echo_area_buffer[0] = Qnil; - message_cleared_p = true; - if (FUNCTIONP (Vclear_message_function)) { specpdl_ref count = SPECPDL_INDEX (); specbind (Qinhibit_quit, Qt); - safe_call (1, Vclear_message_function); + preserve = safe_call (1, Vclear_message_function); unbind_to (count, Qnil); } + + if (!EQ (preserve, Qdont_clear_message)) + { + echo_area_buffer[0] = Qnil; + message_cleared_p = true; + } } if (last_displayed_p) @@ -13233,6 +13250,20 @@ gui_consider_frame_title (Lisp_Object frame) && (update_mode_lines == 0 \ || update_mode_lines == REDISPLAY_SOME)) +static bool +needs_no_redisplay (struct window *w) +{ + struct buffer *buffer = XBUFFER (w->contents); + struct frame *f = XFRAME (w->frame); + return (REDISPLAY_SOME_P () + && !w->redisplay + && !w->update_mode_line + && !f->face_change + && !f->redisplay + && !buffer->text->redisplay + && window_point (w) == w->last_point); +} + /* Prepare for redisplay by updating menu-bar item lists when appropriate. This can call eval. */ @@ -13254,13 +13285,8 @@ prepare_menu_bars (void) struct window *w = XWINDOW (this); /* Cf. conditions for redisplaying a window at the beginning of redisplay_window. */ - if (w->redisplay - || XFRAME (w->frame)->redisplay - || XBUFFER (w->contents)->text->redisplay - || BUF_PT (XBUFFER (w->contents)) != w->last_point) - { - windows = Fcons (this, windows); - } + if (!needs_no_redisplay (w)) + windows = Fcons (this, windows); } } safe__call1 (true, Vpre_redisplay_function, windows); @@ -18929,14 +18955,7 @@ redisplay_window (Lisp_Object window, bool just_this_one_p) *w->desired_matrix->method = 0; #endif - if (!just_this_one_p - && REDISPLAY_SOME_P () - && !w->redisplay - && !w->update_mode_line - && !f->face_change - && !f->redisplay - && !buffer->text->redisplay - && BUF_PT (buffer) == w->last_point) + if (!just_this_one_p && needs_no_redisplay (w)) return; /* Make sure that both W's markers are valid. */ @@ -22125,7 +22144,7 @@ get_overlay_arrow_glyph_row (struct window *w, Lisp_Object overlay_arrow_string) struct buffer *buffer = XBUFFER (w->contents); struct buffer *old = current_buffer; const unsigned char *arrow_string = SDATA (overlay_arrow_string); - ptrdiff_t arrow_len = SCHARS (overlay_arrow_string); + ptrdiff_t arrow_len = SBYTES (overlay_arrow_string), char_num = 0; const unsigned char *arrow_end = arrow_string + arrow_len; const unsigned char *p; struct it it; @@ -22156,7 +22175,7 @@ get_overlay_arrow_glyph_row (struct window *w, Lisp_Object overlay_arrow_string) p += it.len; /* Get its face. */ - ilisp = make_fixnum (p - arrow_string); + ilisp = make_fixnum (char_num++); face = Fget_text_property (ilisp, Qface, overlay_arrow_string); it.face_id = compute_char_face (f, it.char_to_display, face); @@ -36545,12 +36564,20 @@ message displayed by this function), and `command-error-function' (which controls how error messages are displayed). */); Vset_message_function = Qnil; + DEFSYM (Qdont_clear_message, "dont-clear-message"); DEFVAR_LISP ("clear-message-function", Vclear_message_function, doc: /* If non-nil, function to clear echo-area messages. Usually this function is called when the next input event arrives. -The function is called without arguments. It is expected to clear the -message displayed by its counterpart function specified by -`set-message-function'. */); +It is expected to clear the message displayed by its counterpart +function specified by `set-message-function'. + +The function is called without arguments. + +If this function returns a value that isn't `dont-clear-message', the +message is cleared from the echo area as usual. If this function +returns `dont-clear-message', this means that the message was already +handled, and the original message text will not be cleared from the +echo area. */); Vclear_message_function = Qnil; DEFVAR_LISP ("redisplay--all-windows-cause", Vredisplay__all_windows_cause, diff --git a/src/xfaces.c b/src/xfaces.c index d7f1f4d96e5..05e0df4b7dc 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -1450,9 +1450,9 @@ enum xlfd_field }; /* Order by which font selection chooses fonts. The default values - mean `first, find a best match for the font width, then for the - font height, then for weight, then for slant.' This variable can be - set via set-face-font-sort-order. */ + mean "first, find a best match for the font width, then for the + font height, then for weight, then for slant." This variable can be + set via 'internal-set-font-selection-order'. */ static int font_sort_order[4]; @@ -1503,16 +1503,22 @@ If FAMILY is omitted or nil, list all families. Otherwise, FAMILY must be a string, possibly containing wildcards `?' and `*'. If FRAME is omitted or nil, use the selected frame. + Each element of the result is a vector [FAMILY WIDTH POINT-SIZE WEIGHT SLANT FIXED-P FULL REGISTRY-AND-ENCODING]. -FAMILY is the font family name. POINT-SIZE is the size of the -font in 1/10 pt. WIDTH, WEIGHT, and SLANT are symbols describing the -width, weight and slant of the font. These symbols are the same as for -face attributes. FIXED-P is non-nil if the font is fixed-pitch. -FULL is the full name of the font, and REGISTRY-AND-ENCODING is a string -giving the registry and encoding of the font. -The result list is sorted according to the current setting of -the face font sort order. */) + +FAMILY is the font family name. +POINT-SIZE is the size of the font in 1/10 pt. +WIDTH, WEIGHT, and SLANT are symbols describing the width, weight + and slant of the font. These symbols are the same as for face + attributes, see `set-face-attribute'. +FIXED-P is non-nil if the font is fixed-pitch. +FULL is the full name of the font. +REGISTRY-AND-ENCODING is a string giving the registry and encoding of + the font. + +The resulting list is sorted according to the current setting of +the face font sort order, see `face-font-selection-order'. */) (Lisp_Object family, Lisp_Object frame) { Lisp_Object font_spec, list, *drivers, vec; @@ -1573,7 +1579,14 @@ the face font sort order. */) make_fixnum (point), FONT_WEIGHT_SYMBOLIC (font), FONT_SLANT_SYMBOLIC (font), - NILP (spacing) || EQ (spacing, Qp) ? Qnil : Qt, + (NILP (spacing) + || EQ (spacing, Qp) + /* If the font was specified in a way + different from XLFD (e.g., on MS-Windows), + we will have a number there, not 'p'. */ + || EQ (spacing, + make_fixnum (FONT_SPACING_PROPORTIONAL))) + ? Qnil : Qt, Ffont_xlfd_name (font, Qnil), AREF (font, FONT_REGISTRY_INDEX)); result = Fcons (v, result); @@ -4434,17 +4447,26 @@ free_realized_face (struct frame *f, struct face *face) void prepare_face_for_display (struct frame *f, struct face *face) { + Emacs_GC egc; + unsigned long mask; + eassert (FRAME_WINDOW_P (f)); if (face->gc == 0) { - Emacs_GC egc; - unsigned long mask = GCForeground | GCBackground | GCGraphicsExposures; + mask = GCForeground | GCBackground | GCGraphicsExposures; egc.foreground = face->foreground; egc.background = face->background; #ifdef HAVE_X_WINDOWS egc.graphics_exposures = False; + + /* While this was historically slower than a line_width of 0, + the difference no longer matters on modern X servers, so set + it to 1 in order for PolyLine requests to behave consistently + everywhere. */ + mask |= GCLineWidth; + egc.line_width = 1; #endif block_input (); diff --git a/src/xfns.c b/src/xfns.c index 2f90534c484..dc8f02780ce 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -730,9 +730,11 @@ 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)}; +#ifdef HAVE_GTK3 + GObjectClass *object_class; + GtkWidgetClass *class; #endif gui_set_alpha_background (f, arg, oldval); @@ -776,6 +778,24 @@ x_set_alpha_background (struct frame *f, Lisp_Object arg, Lisp_Object oldval) FRAME_DISPLAY_INFO (f)->Xatom_net_wm_opaque_region, XA_CARDINAL, 32, PropModeReplace, (unsigned char *) &opaque_region, 4); +#else + else + { + if (FRAME_TOOLTIP_P (f)) + 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); + else + { + object_class = G_OBJECT_GET_CLASS (FRAME_GTK_OUTER_WIDGET (f)); + class = GTK_WIDGET_CLASS (object_class); + + if (class->style_updated) + class->style_updated (FRAME_GTK_OUTER_WIDGET (f)); + } + } #endif } @@ -803,22 +823,24 @@ x_set_tool_bar_position (struct frame *f, wrong_choice (choice, new_value); } +#ifdef HAVE_XDBE static void x_set_inhibit_double_buffering (struct frame *f, Lisp_Object new_value, Lisp_Object old_value) { - block_input (); + bool want_double_buffering, was_double_buffered; + if (FRAME_X_WINDOW (f) && !EQ (new_value, old_value)) { - bool want_double_buffering = NILP (new_value); - bool was_double_buffered = FRAME_X_DOUBLE_BUFFERED_P (f); - /* font_drop_xrender_surfaces in xftfont does something only if - we're double-buffered, so call font_drop_xrender_surfaces before - and after any potential change. One of the calls will end up - being a no-op. */ + want_double_buffering = NILP (new_value); + was_double_buffered = FRAME_X_DOUBLE_BUFFERED_P (f); + + block_input (); if (want_double_buffering != was_double_buffered) { + /* Force XftDraw etc to be recreated with the new double + buffered drawable. */ font_drop_xrender_surfaces (f); /* Scroll bars decide whether or not to use a back buffer @@ -840,9 +862,10 @@ x_set_inhibit_double_buffering (struct frame *f, SET_FRAME_GARBAGED (f); font_drop_xrender_surfaces (f); } + unblock_input (); } - unblock_input (); } +#endif /** * x_set_undecorated: @@ -3528,8 +3551,11 @@ xic_set_xfontset (struct frame *f, const char *base_fontname) void x_mark_frame_dirty (struct frame *f) { - if (FRAME_X_DOUBLE_BUFFERED_P (f) && !FRAME_X_NEED_BUFFER_FLIP (f)) +#ifdef HAVE_XDBE + if (FRAME_X_DOUBLE_BUFFERED_P (f) + && !FRAME_X_NEED_BUFFER_FLIP (f)) FRAME_X_NEED_BUFFER_FLIP (f) = true; +#endif } static void @@ -3610,12 +3636,12 @@ tear_down_x_back_buffer (struct frame *f) void initial_set_up_x_back_buffer (struct frame *f) { - block_input (); eassert (FRAME_X_WINDOW (f)); FRAME_X_RAW_DRAWABLE (f) = FRAME_X_WINDOW (f); - if (NILP (CDR (Fassq (Qinhibit_double_buffering, f->param_alist)))) + + if (NILP (CDR (Fassq (Qinhibit_double_buffering, + f->param_alist)))) set_up_x_back_buffer (f); - unblock_input (); } #if defined HAVE_XINPUT2 @@ -3688,15 +3714,6 @@ setup_xi_event_mask (struct frame *f) XISelectEvents (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), &mask, 1); - -#if defined USE_GTK && !defined HAVE_GTK3 - memset (m, 0, l); - XISetMask (m, XI_RawKeyPress); - - XISelectEvents (FRAME_X_DISPLAY (f), - FRAME_DISPLAY_INFO (f)->root_window, - &mask, 1); -#endif unblock_input (); } #endif @@ -4220,7 +4237,7 @@ x_make_gc (struct frame *f) gc_values.foreground = FRAME_FOREGROUND_PIXEL (f); gc_values.background = FRAME_BACKGROUND_PIXEL (f); - gc_values.line_width = 0; /* Means 1 using fast algorithm. */ + gc_values.line_width = 1; f->output_data.x->normal_gc = XCreateGC (FRAME_X_DISPLAY (f), FRAME_X_DRAWABLE (f), @@ -4854,6 +4871,13 @@ This function is an internal primitive--use `make-frame' instead. */) x_icon (f, parms); x_make_gc (f); +#ifdef HAVE_XINPUT2 + if (dpyinfo->supports_xi2) + FRAME_X_OUTPUT (f)->xi_masks + = XIGetSelectedEvents (dpyinfo->display, FRAME_X_WINDOW (f), + &FRAME_X_OUTPUT (f)->num_xi_masks); +#endif + /* Now consider the frame official. */ f->terminal->reference_count++; FRAME_DISPLAY_INFO (f)->reference_count++; @@ -8225,29 +8249,6 @@ x_hide_tip (bool delete) else x_make_frame_invisible (XFRAME (tip_frame)); -#ifdef USE_LUCID - /* Bloodcurdling hack alert: The Lucid menu bar widget's - redisplay procedure is not called when a tip frame over - menu items is unmapped. Redisplay the menu manually... */ - { - Widget w; - struct frame *f = SELECTED_FRAME (); - - if (FRAME_X_P (f) && FRAME_LIVE_P (f)) - { - w = f->output_data.x->menubar_widget; - - if (!DoesSaveUnders (FRAME_DISPLAY_INFO (f)->screen) - && w != NULL) - { - block_input (); - xlwmenu_redisplay (w); - unblock_input (); - } - } - } -#endif /* USE_LUCID */ - was_open = Qt; } else @@ -8274,7 +8275,8 @@ PARMS is an optional list of frame parameters which can be used to change the tooltip's appearance. Automatically hide the tooltip after TIMEOUT seconds. TIMEOUT nil -means use the default timeout of 5 seconds. +means use the default timeout from the `x-show-tooltip-timeout' +variable. If the list of frame parameters PARMS contains a `left' parameter, display the tooltip at that x-position. If the list of frame parameters @@ -8320,9 +8322,8 @@ Text larger than the specified size is clipped. */) f = decode_window_system_frame (frame); if (NILP (timeout)) - timeout = make_fixnum (5); - else - CHECK_FIXNAT (timeout); + timeout = Vx_show_tooltip_timeout; + CHECK_FIXNAT (timeout); if (NILP (dx)) dx = make_fixnum (5); @@ -8619,7 +8620,12 @@ DEFUN ("x-double-buffered-p", Fx_double_buffered_p, Sx_double_buffered_p, (Lisp_Object frame) { struct frame *f = decode_live_frame (frame); + +#ifdef HAVE_XDBE return FRAME_X_DOUBLE_BUFFERED_P (f) ? Qt : Qnil; +#else + return Qnil; +#endif } @@ -8792,25 +8798,11 @@ DEFUN ("x-file-dialog", Fx_file_dialog, Sx_file_dialog, 2, 5, 0, while (result == 0) { XEvent event, copy; -#ifdef HAVE_XINPUT2 - x_menu_wait_for_event (FRAME_X_DISPLAY (f)); -#else x_menu_wait_for_event (0); -#endif - if ( -#ifndef HAVE_XINPUT2 - XtAppPending (Xt_app_con) -#else - XPending (FRAME_X_DISPLAY (f)) -#endif - ) + if (XtAppPending (Xt_app_con)) { -#ifndef HAVE_XINPUT2 XtAppNextEvent (Xt_app_con, &event); -#else - XNextEvent (FRAME_X_DISPLAY (f), &event); -#endif copy = event; if (event.type == KeyPress @@ -9379,7 +9371,11 @@ frame_parm_handler x_frame_parm_handlers[] = gui_set_alpha, x_set_sticky, x_set_tool_bar_position, +#ifdef HAVE_XDBE x_set_inhibit_double_buffering, +#else + NULL, +#endif x_set_undecorated, x_set_parent_frame, x_set_skip_taskbar, diff --git a/src/xftfont.c b/src/xftfont.c index e27c6cf3146..31fb877c35b 100644 --- a/src/xftfont.c +++ b/src/xftfont.c @@ -643,18 +643,23 @@ xftfont_end_for_frame (struct frame *f) return 0; } -/* When using X double buffering, the XftDraw structure we build - seems to be useless once a frame is resized, so recreate it on +/* When using X double buffering, the XRender surfaces we create seem + to become useless once the window acting as the front buffer is + resized for an unknown reason (X server bug?), so recreate it on ConfigureNotify and in some other cases. */ +#ifdef HAVE_XDBE static void xftfont_drop_xrender_surfaces (struct frame *f) { - block_input (); if (FRAME_X_DOUBLE_BUFFERED_P (f)) - xftfont_end_for_frame (f); - unblock_input (); + { + block_input (); + xftfont_end_for_frame (f); + unblock_input (); + } } +#endif static bool xftfont_cached_font_ok (struct frame *f, Lisp_Object font_object, @@ -741,35 +746,37 @@ static void syms_of_xftfont_for_pdumper (void); struct font_driver const xftfont_driver = { /* We can't draw a text without device dependent functions. */ - .type = LISPSYM_INITIALLY (Qxft), - .get_cache = xfont_get_cache, - .list = xftfont_list, - .match = xftfont_match, - .list_family = ftfont_list_family, - .open_font = xftfont_open, - .close_font = xftfont_close, - .prepare_face = xftfont_prepare_face, - .done_face = xftfont_done_face, - .has_char = xftfont_has_char, - .encode_char = xftfont_encode_char, - .text_extents = xftfont_text_extents, - .draw = xftfont_draw, - .get_bitmap = ftfont_get_bitmap, - .anchor_point = ftfont_anchor_point, + .type = LISPSYM_INITIALLY (Qxft), + .get_cache = xfont_get_cache, + .list = xftfont_list, + .match = xftfont_match, + .list_family = ftfont_list_family, + .open_font = xftfont_open, + .close_font = xftfont_close, + .prepare_face = xftfont_prepare_face, + .done_face = xftfont_done_face, + .has_char = xftfont_has_char, + .encode_char = xftfont_encode_char, + .text_extents = xftfont_text_extents, + .draw = xftfont_draw, + .get_bitmap = ftfont_get_bitmap, + .anchor_point = ftfont_anchor_point, #ifdef HAVE_LIBOTF - .otf_capability = ftfont_otf_capability, + .otf_capability = ftfont_otf_capability, #endif - .end_for_frame = xftfont_end_for_frame, + .end_for_frame = xftfont_end_for_frame, #if defined HAVE_M17N_FLT && defined HAVE_LIBOTF - .shape = xftfont_shape, + .shape = xftfont_shape, #endif #if defined HAVE_OTF_GET_VARIATION_GLYPHS || defined HAVE_FT_FACE_GETCHARVARIANTINDEX - .get_variation_glyphs = ftfont_variation_glyphs, + .get_variation_glyphs = ftfont_variation_glyphs, +#endif + .filter_properties = ftfont_filter_properties, + .cached_font_ok = xftfont_cached_font_ok, + .combining_capability = ftfont_combining_capability, +#ifdef HAVE_XDBE + .drop_xrender_surfaces = xftfont_drop_xrender_surfaces, #endif - .filter_properties = ftfont_filter_properties, - .cached_font_ok = xftfont_cached_font_ok, - .combining_capability = ftfont_combining_capability, - .drop_xrender_surfaces = xftfont_drop_xrender_surfaces, }; #ifdef HAVE_HARFBUZZ struct font_driver xfthbfont_driver; diff --git a/src/xmenu.c b/src/xmenu.c index d19fe13c295..418628d4916 100644 --- a/src/xmenu.c +++ b/src/xmenu.c @@ -365,16 +365,16 @@ popup_get_selection (XEvent *initial_event, struct x_display_info *dpyinfo, && event.xgeneric.display == dpyinfo->display && event.xgeneric.extension == dpyinfo->xi2_opcode) { + if (!event.xcookie.data + && XGetEventData (dpyinfo->display, &event.xcookie)) + cookie_claimed_p = true; + 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); @@ -424,10 +424,6 @@ popup_get_selection (XEvent *initial_event, struct x_display_info *dpyinfo, { KeySym keysym; - if (!event.xcookie.data - && XGetEventData (dpyinfo->display, &event.xcookie)) - cookie_claimed_p = true; - xev = (XIDeviceEvent *) event.xcookie.data; copy.xkey.type = KeyPress; @@ -473,6 +469,9 @@ DEFUN ("x-menu-bar-open-internal", Fx_menu_bar_open_internal, Sx_menu_bar_open_i { XEvent ev; struct frame *f = decode_window_system_frame (frame); +#if defined USE_X_TOOLKIT && defined HAVE_XINPUT2 + struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); +#endif Widget menubar; block_input (); @@ -485,12 +484,44 @@ DEFUN ("x-menu-bar-open-internal", Fx_menu_bar_open_internal, Sx_menu_bar_open_i Window child; bool error_p = false; +#if defined USE_X_TOOLKIT && defined HAVE_XINPUT2 + /* Clear the XI2 grab so Motif or lwlib can set a core grab. + Otherwise some versions of Motif will emit a warning and hang, + and lwlib will fail to destroy the menu window. */ + + if (dpyinfo->supports_xi2 + && xi_frame_selected_for (f, XI_ButtonPress)) + { + for (int i = 0; i < dpyinfo->num_devices; ++i) + { + /* The keyboard grab matters too, in this specific + case. */ +#ifndef USE_LUCID + if (dpyinfo->devices[i].grab) +#endif + { + XIUngrabDevice (dpyinfo->display, + dpyinfo->devices[i].device_id, + CurrentTime); + dpyinfo->devices[i].grab = 0; + } + } + } +#endif + x_catch_errors (FRAME_X_DISPLAY (f)); memset (&ev, 0, sizeof ev); ev.xbutton.display = FRAME_X_DISPLAY (f); ev.xbutton.window = XtWindow (menubar); ev.xbutton.root = FRAME_DISPLAY_INFO (f)->root_window; +#ifndef HAVE_XINPUT2 ev.xbutton.time = XtLastTimestampProcessed (FRAME_X_DISPLAY (f)); +#else + ev.xbutton.time = ((dpyinfo->supports_xi2 + && xi_frame_selected_for (f, XI_KeyPress)) + ? dpyinfo->last_user_time + : XtLastTimestampProcessed (dpyinfo->display)); +#endif ev.xbutton.button = Button1; ev.xbutton.x = ev.xbutton.y = FRAME_MENUBAR_HEIGHT (f) / 2; ev.xbutton.same_screen = True; @@ -634,15 +665,15 @@ x_activate_menubar (struct frame *f) Otherwise some versions of Motif will emit a warning and hang, and lwlib will fail to destroy the menu window. */ - if (dpyinfo->num_devices) + if (dpyinfo->supports_xi2 + && xi_frame_selected_for (f, XI_ButtonPress)) { for (int i = 0; i < dpyinfo->num_devices; ++i) { if (dpyinfo->devices[i].grab) - { - XIUngrabDevice (dpyinfo->display, dpyinfo->devices[i].device_id, - CurrentTime); - } + XIUngrabDevice (dpyinfo->display, + dpyinfo->devices[i].device_id, + CurrentTime); } } #endif @@ -1528,7 +1559,8 @@ create_and_show_popup_menu (struct frame *f, widget_value *first_wv, } #if !defined HAVE_GTK3 && defined HAVE_XINPUT2 - if (FRAME_DISPLAY_INFO (f)->num_devices) + if (FRAME_DISPLAY_INFO (f)->supports_xi2 + && xi_frame_selected_for (f, XI_ButtonPress)) { for (int i = 0; i < FRAME_DISPLAY_INFO (f)->num_devices; ++i) { @@ -1686,7 +1718,7 @@ create_and_show_popup_menu (struct frame *f, widget_value *first_wv, XtSetArg (av[ac], (char *) XtNgeometry, 0); ac++; XtSetValues (menu, av, ac); -#if defined HAVE_XINPUT2 +#ifdef HAVE_XINPUT2 struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); bool any_xi_grab_p = false; @@ -1696,7 +1728,8 @@ create_and_show_popup_menu (struct frame *f, widget_value *first_wv, if (dpyinfo->supports_xi2) XGrabServer (dpyinfo->display); - if (dpyinfo->num_devices) + if (dpyinfo->supports_xi2 + && xi_frame_selected_for (f, XI_ButtonPress)) { for (int i = 0; i < dpyinfo->num_devices; ++i) { @@ -1746,20 +1779,14 @@ create_and_show_popup_menu (struct frame *f, widget_value *first_wv, XtDispatchEvent (&property_dummy); } #endif - - if (dpyinfo->supports_xi2) - XUngrabServer (dpyinfo->display); #endif /* Display the menu. */ lw_popup_menu (menu, &dummy); -#if defined HAVE_XINPUT2 && defined USE_MOTIF - /* This is needed to prevent XI_Enter events that set an implicit - focus from being sent. */ +#ifdef HAVE_XINPUT2 if (dpyinfo->supports_xi2) - XSetInputFocus (XtDisplay (menu), XtWindow (menu), - RevertToParent, CurrentTime); + XUngrabServer (dpyinfo->display); #endif popup_activated_flag = 1; @@ -1781,14 +1808,6 @@ create_and_show_popup_menu (struct frame *f, widget_value *first_wv, unbind_to (specpdl_count, Qnil); } - -#if defined HAVE_XINPUT2 && defined USE_MOTIF - /* For some reason input focus isn't always restored to the outer - window after the menu pops down. */ - if (any_xi_grab_p) - XSetInputFocus (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f), - RevertToParent, CurrentTime); -#endif } #endif /* not USE_GTK */ @@ -2677,7 +2696,8 @@ x_menu_show (struct frame *f, int x, int y, int menuflags, struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); /* Clear the XI2 grab so a core grab can be set. */ - if (dpyinfo->num_devices) + if (dpyinfo->supports_xi2 + && xi_frame_selected_for (f, XI_ButtonPress)) { for (int i = 0; i < dpyinfo->num_devices; ++i) { diff --git a/src/xrdb.c b/src/xrdb.c index 56e07f74a26..aa79d719c8c 100644 --- a/src/xrdb.c +++ b/src/xrdb.c @@ -383,14 +383,6 @@ x_load_resources (Display *display, const char *xrm_string, XrmDatabase db; char line[256]; -#if defined USE_MOTIF || !(defined USE_CAIRO || defined HAVE_XFT) || !defined USE_LUCID - const char *helv = "-*-helvetica-medium-r-*--*-120-*-*-*-*-iso8859-1"; -#endif - -#ifdef USE_MOTIF - const char *courier = "-*-courier-medium-r-*-*-*-120-*-*-*-*-iso8859-1"; -#endif - x_rm_string = XrmStringToQuark (XrmStringType); #ifndef USE_X_TOOLKIT /* pmr@osf.org says this shouldn't be done if USE_X_TOOLKIT. @@ -399,47 +391,7 @@ x_load_resources (Display *display, const char *xrm_string, #endif rdb = XrmGetStringDatabase (""); - /* Add some font defaults. If the font `helv' doesn't exist, widgets - will use some other default font. */ #ifdef USE_MOTIF - - sprintf (line, "%s.pane.background: grey75", myclass); - XrmPutLineResource (&rdb, line); - sprintf (line, "%s*fontList: %s", myclass, helv); - XrmPutLineResource (&rdb, line); - sprintf (line, "%s*menu*background: grey75", myclass); - XrmPutLineResource (&rdb, line); - sprintf (line, "%s*menubar*background: grey75", myclass); - XrmPutLineResource (&rdb, line); - sprintf (line, "%s*verticalScrollBar.background: grey75", myclass); - XrmPutLineResource (&rdb, line); - sprintf (line, "%s*verticalScrollBar.troughColor: grey75", myclass); - XrmPutLineResource (&rdb, line); - sprintf (line, "%s*horizontalScrollBar.background: grey75", myclass); - XrmPutLineResource (&rdb, line); - sprintf (line, "%s*horizontalScrollBar.troughColor: grey75", myclass); - XrmPutLineResource (&rdb, line); - sprintf (line, "%s.dialog*.background: grey75", myclass); - XrmPutLineResource (&rdb, line); - sprintf (line, "%s*fsb.Text.background: white", myclass); - XrmPutLineResource (&rdb, line); - sprintf (line, "%s*fsb.FilterText.background: white", myclass); - XrmPutLineResource (&rdb, line); - sprintf (line, "%s*fsb*DirList.background: white", myclass); - XrmPutLineResource (&rdb, line); - sprintf (line, "%s*fsb*ItemsList.background: white", myclass); - XrmPutLineResource (&rdb, line); - sprintf (line, "%s*fsb*background: grey75", myclass); - XrmPutLineResource (&rdb, line); - sprintf (line, "%s*fsb.Text.fontList: %s", myclass, courier); - XrmPutLineResource (&rdb, line); - sprintf (line, "%s*fsb.FilterText.fontList: %s", myclass, courier); - XrmPutLineResource (&rdb, line); - sprintf (line, "%s*fsb*ItemsList.fontList: %s", myclass, courier); - XrmPutLineResource (&rdb, line); - sprintf (line, "%s*fsb*DirList.fontList: %s", myclass, courier); - XrmPutLineResource (&rdb, line); - /* Set double click time of list boxes in the file selection dialog from `double-click-time'. */ if (FIXNUMP (Vdouble_click_time) && XFIXNUM (Vdouble_click_time) > 0) @@ -451,15 +403,17 @@ x_load_resources (Display *display, const char *xrm_string, myclass, XFIXNAT (Vdouble_click_time)); XrmPutLineResource (&rdb, line); } - #else /* not USE_MOTIF */ - + /* Add some font defaults. If the font `helv' doesn't exist, + widgets will use some other default font. */ sprintf (line, "Emacs.dialog*.background: grey75"); XrmPutLineResource (&rdb, line); #if !(defined USE_CAIRO || defined HAVE_XFT) || !defined (USE_LUCID) - sprintf (line, "Emacs.dialog*.font: %s", helv); + sprintf (line, "Emacs.dialog*.font: %s", + "-*-helvetica-medium-r-*--*-120-*-*-*-*-iso8859-1"); XrmPutLineResource (&rdb, line); - sprintf (line, "*XlwMenu*font: %s", helv); + sprintf (line, "*XlwMenu*font: %s", + "-*-helvetica-medium-r-*--*-120-*-*-*-*-iso8859-1"); XrmPutLineResource (&rdb, line); #endif sprintf (line, "*XlwMenu*background: grey75"); @@ -468,7 +422,6 @@ x_load_resources (Display *display, const char *xrm_string, XrmPutLineResource (&rdb, line); sprintf (line, "Emacs*horizontalScrollBar.background: grey75"); XrmPutLineResource (&rdb, line); - #endif /* not USE_MOTIF */ user_database = get_user_db (display); diff --git a/src/xselect.c b/src/xselect.c index f855980a300..3acfcbe94b0 100644 --- a/src/xselect.c +++ b/src/xselect.c @@ -60,6 +60,8 @@ static Lisp_Object selection_data_to_lisp_data (struct x_display_info *, ptrdiff_t, Atom, int); static void lisp_data_to_selection_data (struct x_display_info *, Lisp_Object, struct selection_data *); +static void x_send_client_event (Lisp_Object, Lisp_Object, Lisp_Object, + Atom, Lisp_Object, Lisp_Object); /* Printing traces to stderr. */ @@ -208,24 +210,49 @@ static Atom symbol_to_x_atom (struct x_display_info *dpyinfo, Lisp_Object sym) { Atom val; - if (NILP (sym)) return 0; - if (EQ (sym, QPRIMARY)) return XA_PRIMARY; - if (EQ (sym, QSECONDARY)) return XA_SECONDARY; - if (EQ (sym, QSTRING)) return XA_STRING; - if (EQ (sym, QINTEGER)) return XA_INTEGER; - if (EQ (sym, QATOM)) return XA_ATOM; - if (EQ (sym, QCLIPBOARD)) return dpyinfo->Xatom_CLIPBOARD; - if (EQ (sym, QTIMESTAMP)) return dpyinfo->Xatom_TIMESTAMP; - if (EQ (sym, QTEXT)) return dpyinfo->Xatom_TEXT; - if (EQ (sym, QCOMPOUND_TEXT)) return dpyinfo->Xatom_COMPOUND_TEXT; - if (EQ (sym, QUTF8_STRING)) return dpyinfo->Xatom_UTF8_STRING; - if (EQ (sym, QDELETE)) return dpyinfo->Xatom_DELETE; - if (EQ (sym, QMULTIPLE)) return dpyinfo->Xatom_MULTIPLE; - if (EQ (sym, QINCR)) return dpyinfo->Xatom_INCR; - if (EQ (sym, Q_EMACS_TMP_)) return dpyinfo->Xatom_EMACS_TMP; - if (EQ (sym, QTARGETS)) return dpyinfo->Xatom_TARGETS; - if (EQ (sym, QNULL)) return dpyinfo->Xatom_NULL; - if (!SYMBOLP (sym)) emacs_abort (); + if (NILP (sym)) + return 0; + if (EQ (sym, QPRIMARY)) + return XA_PRIMARY; + if (EQ (sym, QSECONDARY)) + return XA_SECONDARY; + if (EQ (sym, QSTRING)) + return XA_STRING; + if (EQ (sym, QINTEGER)) + return XA_INTEGER; + if (EQ (sym, QATOM)) + return XA_ATOM; + if (EQ (sym, QCLIPBOARD)) + return dpyinfo->Xatom_CLIPBOARD; + if (EQ (sym, QTIMESTAMP)) + return dpyinfo->Xatom_TIMESTAMP; + if (EQ (sym, QTEXT)) + return dpyinfo->Xatom_TEXT; + if (EQ (sym, QCOMPOUND_TEXT)) + return dpyinfo->Xatom_COMPOUND_TEXT; + if (EQ (sym, QUTF8_STRING)) + return dpyinfo->Xatom_UTF8_STRING; + if (EQ (sym, QDELETE)) + return dpyinfo->Xatom_DELETE; + if (EQ (sym, QMULTIPLE)) + return dpyinfo->Xatom_MULTIPLE; + if (EQ (sym, QINCR)) + return dpyinfo->Xatom_INCR; + if (EQ (sym, Q_EMACS_TMP_)) + return dpyinfo->Xatom_EMACS_TMP; + if (EQ (sym, QTARGETS)) + return dpyinfo->Xatom_TARGETS; + if (EQ (sym, QNULL)) + return dpyinfo->Xatom_NULL; + if (EQ (sym, QXdndSelection)) + return dpyinfo->Xatom_XdndSelection; + if (EQ (sym, QXmTRANSFER_SUCCESS)) + return dpyinfo->Xatom_XmTRANSFER_SUCCESS; + if (EQ (sym, QXmTRANSFER_FAILURE)) + return dpyinfo->Xatom_XmTRANSFER_FAILURE; + + if (!SYMBOLP (sym)) + emacs_abort (); TRACE1 (" XInternAtom %s", SSDATA (SYMBOL_NAME (sym))); block_input (); @@ -287,6 +314,10 @@ x_atom_to_symbol (struct x_display_info *dpyinfo, Atom atom) return QNULL; if (atom == dpyinfo->Xatom_XdndSelection) return QXdndSelection; + if (atom == dpyinfo->Xatom_XmTRANSFER_SUCCESS) + return QXmTRANSFER_SUCCESS; + if (atom == dpyinfo->Xatom_XmTRANSFER_FAILURE) + return QXmTRANSFER_FAILURE; block_input (); x_catch_errors (dpyinfo->display); @@ -2583,7 +2614,7 @@ are ignored. */) return Qnil; } -void +static void x_send_client_event (Lisp_Object display, Lisp_Object dest, Lisp_Object from, Atom message_type, Lisp_Object format, Lisp_Object values) { @@ -2793,6 +2824,9 @@ A value of 0 means wait as long as necessary. This is initialized from the DEFSYM (Qx_lost_selection_functions, "x-lost-selection-functions"); DEFSYM (Qx_sent_selection_functions, "x-sent-selection-functions"); + DEFSYM (QXmTRANSFER_SUCCESS, "XmTRANSFER_SUCCESS"); + DEFSYM (QXmTRANSFER_FAILURE, "XmTRANSFER_FAILURE"); + pdumper_do_now_and_after_load (syms_of_xselect_for_pdumper); } diff --git a/src/xsmfns.c b/src/xsmfns.c index 199e3ded3dd..7015a8eb633 100644 --- a/src/xsmfns.c +++ b/src/xsmfns.c @@ -522,7 +522,7 @@ Do not call this function yourself. */) { /* We should not do user interaction here, but it is not easy to prevent. Fix this in next version. */ - Fkill_emacs (Qnil); + Fkill_emacs (Qnil, Qnil); #if false /* This will not be reached, but we want kill-emacs-hook to be run. */ diff --git a/src/xterm.c b/src/xterm.c index 2999480659b..80d34c114d4 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -617,6 +617,9 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <errno.h> #include <sys/stat.h> #include <flexmember.h> +#include <c-ctype.h> +#include <byteswap.h> + #include "character.h" #include "coding.h" #include "composite.h" @@ -756,6 +759,10 @@ static bool toolkit_scroll_bar_interaction; static Time ignore_next_mouse_click_timeout; +/* The display that ignore_next_mouse_click_timeout applies to. */ + +static struct x_display_info *mouse_click_timeout_display; + /* Used locally within XTread_socket. */ static int x_noop_count; @@ -869,6 +876,10 @@ struct frame *x_dnd_frame; important information. */ static bool x_dnd_waiting_for_finish; +/* The display the drop target that is supposed to send information is + on. */ +static Display *x_dnd_finish_display; + /* State of the Motif drop operation. 0 means nothing has happened, i.e. the event loop should not wait @@ -880,6 +891,10 @@ static bool x_dnd_waiting_for_finish; XmTRANSFER_SUCCESS or XmTRANSFER_FAILURE. */ static int x_dnd_waiting_for_motif_finish; +/* The display the Motif drag receiver will send response data + from. */ +struct x_display_info *x_dnd_waiting_for_motif_finish_display; + /* Whether or not F1 was pressed during the drag-and-drop operation. Motif programs rely on this to decide whether or not help @@ -986,6 +1001,15 @@ static struct frame *x_dnd_movement_frame; with. */ static int x_dnd_movement_x, x_dnd_movement_y; +#ifdef HAVE_XKB +/* The keyboard state during the drag-and-drop operation. */ +static unsigned int x_dnd_keyboard_state; +#endif + +/* jmp_buf that gets us out of the IO error handler if an error occurs + terminating DND as part of the display disconnect handler. */ +static jmp_buf x_dnd_disconnect_handler; + struct x_client_list_window { Window window; @@ -1031,6 +1055,8 @@ typedef enum xm_byte_order #endif } xm_byte_order; +#ifdef ENABLE_CHECKING + #define SWAPCARD32(l) \ { \ struct { unsigned t : 32; } bit32; \ @@ -1050,6 +1076,11 @@ typedef enum xm_byte_order s = bit16.t; \ } +#else +#define SWAPCARD32(l) bswap_32 (l) +#define SWAPCARD16(l) bswap_16 (l) +#endif + typedef struct xm_targets_table_header { /* BYTE */ uint8_t byte_order; @@ -1348,6 +1379,12 @@ xm_write_drag_initiator_info (Display *dpy, Window wdesc, buf[0] = info->byteorder; buf[1] = info->protocol; + if (info->byteorder != XM_BYTE_ORDER_CUR_FIRST) + { + SWAPCARD16 (info->table_index); + SWAPCARD16 (info->selection); + } + *((uint16_t *) (buf + 2)) = info->table_index; *((uint32_t *) (buf + 4)) = info->selection; @@ -1355,17 +1392,31 @@ xm_write_drag_initiator_info (Display *dpy, Window wdesc, PropModeReplace, (unsigned char *) buf, 8); } +static int +xm_drag_window_error_handler (Display *display, XErrorEvent *event) +{ + return 0; +} + +static _Noreturn int +xm_drag_window_io_error_handler (Display *dpy) +{ + /* DPY isn't created through GDK, so it doesn't matter if we don't + crash here. */ + longjmp (x_dnd_disconnect_handler, 1); +} + static Window xm_get_drag_window (struct x_display_info *dpyinfo) { - Atom actual_type; + Atom actual_type, _MOTIF_DRAG_WINDOW; int rc, actual_format; unsigned long nitems, bytes_remaining; unsigned char *tmp_data = NULL; Window drag_window; XSetWindowAttributes attrs; - XWindowAttributes wattrs; Display *temp_display; + void *old_handler, *old_io_handler; drag_window = None; rc = XGetWindowProperty (dpyinfo->display, dpyinfo->root_window, @@ -1381,8 +1432,10 @@ xm_get_drag_window (struct x_display_info *dpyinfo) { drag_window = *(Window *) tmp_data; x_catch_errors (dpyinfo->display); - XGetWindowAttributes (dpyinfo->display, - drag_window, &wattrs); + /* We use ButtonPressMask since it's one of the events an + input-only window can never get. */ + XSelectInput (dpyinfo->display, drag_window, + ButtonPressMask); rc = !x_had_errors_p (dpyinfo->display); x_uncatch_errors_after_check (); @@ -1397,35 +1450,78 @@ xm_get_drag_window (struct x_display_info *dpyinfo) if (drag_window == None) { block_input (); + old_io_handler = XSetIOErrorHandler (xm_drag_window_io_error_handler); + + if (sigsetjmp (x_dnd_disconnect_handler, 1)) + { + XSetIOErrorHandler (old_io_handler); + unblock_input (); + + return None; + } + unrequest_sigio (); temp_display = XOpenDisplay (XDisplayString (dpyinfo->display)); request_sigio (); if (!temp_display) { + XSetIOErrorHandler (old_io_handler); unblock_input (); + return None; } XGrabServer (temp_display); XSetCloseDownMode (temp_display, RetainPermanent); - attrs.override_redirect = True; - drag_window = XCreateWindow (temp_display, DefaultRootWindow (temp_display), - -1, -1, 1, 1, 0, CopyFromParent, InputOnly, - CopyFromParent, CWOverrideRedirect, &attrs); - XChangeProperty (temp_display, DefaultRootWindow (temp_display), - XInternAtom (temp_display, - "_MOTIF_DRAG_WINDOW", False), - XA_WINDOW, 32, PropModeReplace, - (unsigned char *) &drag_window, 1); + + /* We can't use XErrorHandler since it's not in the Xlib + specification, and Emacs tries to be portable. */ + old_handler = (void *) XSetErrorHandler (xm_drag_window_error_handler); + + _MOTIF_DRAG_WINDOW = XInternAtom (temp_display, + "_MOTIF_DRAG_WINDOW", False); + + /* Some other program might've created a drag window between now + and when we first looked. Use that if it exists. */ + + tmp_data = NULL; + rc = XGetWindowProperty (temp_display, DefaultRootWindow (temp_display), + _MOTIF_DRAG_WINDOW, 0, 1, False, XA_WINDOW, + &actual_type, &actual_format, &nitems, + &bytes_remaining, &tmp_data) == Success; + + if (rc && actual_type == XA_WINDOW + && actual_format == 32 && nitems == 1 + && tmp_data) + drag_window = *(Window *) tmp_data; + + if (tmp_data) + XFree (tmp_data); + + if (drag_window == None) + { + attrs.override_redirect = True; + drag_window = XCreateWindow (temp_display, DefaultRootWindow (temp_display), + -1, -1, 1, 1, 0, CopyFromParent, InputOnly, + CopyFromParent, CWOverrideRedirect, &attrs); + XChangeProperty (temp_display, DefaultRootWindow (temp_display), + _MOTIF_DRAG_WINDOW, XA_WINDOW, 32, PropModeReplace, + (unsigned char *) &drag_window, 1); + } + XCloseDisplay (temp_display); + XSetErrorHandler (old_handler); + XSetIOErrorHandler (old_io_handler); /* Make sure the drag window created is actually valid for the current display, and the XOpenDisplay above didn't accidentally connect to some other display. */ x_catch_errors (dpyinfo->display); - XGetWindowAttributes (dpyinfo->display, - drag_window, &wattrs); + /* We use ButtonPressMask since it's one of the events an + input-only window can never get. */ + XSelectInput (dpyinfo->display, drag_window, + ButtonPressMask); rc = !x_had_errors_p (dpyinfo->display); x_uncatch_errors_after_check (); unblock_input (); @@ -1438,7 +1534,6 @@ xm_get_drag_window (struct x_display_info *dpyinfo) return drag_window; } -/* TODO: overflow checks when inserting targets. */ static int xm_setup_dnd_targets (struct x_display_info *dpyinfo, Atom *targets, int ntargets) @@ -1453,6 +1548,7 @@ xm_setup_dnd_targets (struct x_display_info *dpyinfo, xm_byte_order byteorder; uint8_t *data; ptrdiff_t total_bytes, total_items, i; + uint32_t size, target_count; drag_window = xm_get_drag_window (dpyinfo); @@ -1468,8 +1564,7 @@ xm_setup_dnd_targets (struct x_display_info *dpyinfo, XGrabServer (dpyinfo->display); rc = XGetWindowProperty (dpyinfo->display, drag_window, dpyinfo->Xatom_MOTIF_DRAG_TARGETS, - /* Do larger values occur in practice? */ - 0L, 20000L, False, + 0L, LONG_MAX, False, dpyinfo->Xatom_MOTIF_DRAG_TARGETS, &actual_type, &actual_format, &nitems, &bytes_remaining, &tmp_data) == Success; @@ -1560,26 +1655,70 @@ xm_setup_dnd_targets (struct x_display_info *dpyinfo, if (idx == -1) { - header.target_list_count++; - header.total_data_size += 2 + ntargets * 4; + target_count = header.target_list_count; + rc = false; + + if (INT_ADD_WRAPV (header.target_list_count, 1, + &header.target_list_count) + || INT_MULTIPLY_WRAPV (ntargets, 4, &size) + || INT_ADD_WRAPV (header.total_data_size, size, + &header.total_data_size) + || INT_ADD_WRAPV (header.total_data_size, 2, + &header.total_data_size)) + { + /* Overflow, remove every entry from the targets table + and add one for our current targets list. This + confuses real Motif but not GTK 2.x, and there is no + other choice. */ - recs[header.target_list_count - 1] - = xmalloc (FLEXSIZEOF (struct xm_targets_table_rec, - targets, ntargets * 4)); - recs[header.target_list_count - 1]->n_targets = ntargets; + for (i = 0; i < target_count; ++i) + xfree (recs[i]); - for (i = 0; i < ntargets; ++i) - recs[header.target_list_count - 1]->targets[i] = targets_sorted[i]; + xfree (recs); - idx = header.target_list_count - 1; - rc = false; + header.byte_order = XM_BYTE_ORDER_CUR_FIRST; + header.protocol = 0; + header.target_list_count = 1; + header.total_data_size = 8 + 2 + ntargets * 4; + + recs = xmalloc (sizeof *recs); + recs[0] = xmalloc (FLEXSIZEOF (struct xm_targets_table_rec, + targets, ntargets * 4)); + + recs[0]->n_targets = ntargets; + + for (i = 0; i < ntargets; ++i) + recs[0]->targets[i] = targets_sorted[i]; + + idx = 0; + } + else + { + recs[header.target_list_count - 1] + = xmalloc (FLEXSIZEOF (struct xm_targets_table_rec, + targets, ntargets * 4)); + recs[header.target_list_count - 1]->n_targets = ntargets; + + for (i = 0; i < ntargets; ++i) + recs[header.target_list_count - 1]->targets[i] = targets_sorted[i]; + + idx = header.target_list_count - 1; + } } } if (!rc) - xm_write_targets_table (dpyinfo->display, drag_window, - dpyinfo->Xatom_MOTIF_DRAG_TARGETS, - &header, recs); + { + /* Some implementations of Motif DND set the protocol version of + just the targets table to 1 without actually changing the + data format. To avoid confusing Motif when that happens, set + it back to 0. There will probably be no more updates to the + protocol either. */ + header.protocol = 0; + xm_write_targets_table (dpyinfo->display, drag_window, + dpyinfo->Xatom_MOTIF_DRAG_TARGETS, + &header, recs); + } XUngrabServer (dpyinfo->display); @@ -2465,8 +2604,17 @@ x_dnd_compute_toplevels (struct x_display_info *dpyinfo) return 0; } -#define X_DND_SUPPORTED_VERSION 5 +static _Noreturn int +x_dnd_io_error_handler (Display *display) +{ +#ifdef USE_GTK + emacs_abort (); +#else + longjmp (x_dnd_disconnect_handler, 1); +#endif +} +#define X_DND_SUPPORTED_VERSION 5 static int x_dnd_get_window_proto (struct x_display_info *, Window); static Window x_dnd_get_window_proxy (struct x_display_info *, Window); @@ -3339,7 +3487,8 @@ x_dnd_send_enter (struct frame *f, Window target, int supported) static void x_dnd_send_position (struct frame *f, Window target, int supported, unsigned short root_x, unsigned short root_y, - Time timestamp, Atom action) + Time timestamp, Atom action, int button, + unsigned state) { struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); XEvent msg; @@ -3380,6 +3529,22 @@ x_dnd_send_position (struct frame *f, Window target, int supported, msg.xclient.window = target; msg.xclient.data.l[0] = FRAME_X_WINDOW (f); msg.xclient.data.l[1] = 0; + + if (supported >= 5) + { + if (button >= 4 && button <= 8) + { + msg.xclient.data.l[1] |= (1 << 9); + msg.xclient.data.l[1] |= (button - 4) << 7; + } + else if (button) + return; + + msg.xclient.data.l[1] |= state & 0x3f; + } + else if (button) + return; + msg.xclient.data.l[2] = (root_x << 16) | root_y; msg.xclient.data.l[3] = 0; msg.xclient.data.l[4] = 0; @@ -3591,6 +3756,17 @@ x_dnd_cleanup_drag_and_drop (void *frame) XSelectInput (FRAME_X_DISPLAY (f), FRAME_DISPLAY_INFO (f)->root_window, x_dnd_old_window_attrs.your_event_mask); + +#ifdef HAVE_XKB + if (FRAME_DISPLAY_INFO (f)->supports_xkb) + XkbSelectEvents (FRAME_X_DISPLAY (f), XkbUseCoreKbd, + XkbStateNotifyMask, 0); +#endif + + /* Delete the Motif drag initiator info if it was set up. */ + if (x_dnd_motif_setup_p) + XDeleteProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), + FRAME_DISPLAY_INFO (f)->Xatom_XdndSelection); unblock_input (); x_dnd_frame = NULL; @@ -3612,6 +3788,7 @@ x_flush (struct frame *f) unblock_input (); } +#ifdef HAVE_XDBE static void x_drop_xrender_surfaces (struct frame *f) { @@ -3627,6 +3804,7 @@ x_drop_xrender_surfaces (struct frame *f) } #endif } +#endif #ifdef HAVE_XRENDER void @@ -3687,6 +3865,29 @@ record_event (char *locus, int type) #endif +#ifdef HAVE_XINPUT2 +bool +xi_frame_selected_for (struct frame *f, unsigned long event) +{ + XIEventMask *masks; + int i; + + masks = FRAME_X_OUTPUT (f)->xi_masks; + + if (!masks) + return false; + + for (i = 0; i < FRAME_X_OUTPUT (f)->num_xi_masks; ++i) + { + if (masks[i].mask_len >= XIMaskLen (event) + && XIMaskIsSet (masks[i].mask, event)) + return true; + } + + return false; +} +#endif + static void x_toolkit_position (struct frame *f, int x, int y, bool *menu_bar_p, bool *tool_bar_p) @@ -3727,7 +3928,6 @@ x_toolkit_position (struct frame *f, int x, int y, static void x_update_opaque_region (struct frame *f, XEvent *configure) { -#ifndef HAVE_GTK3 unsigned long opaque_region[] = {0, 0, (configure ? configure->xconfigure.width @@ -3735,6 +3935,9 @@ x_update_opaque_region (struct frame *f, XEvent *configure) (configure ? configure->xconfigure.height : FRAME_PIXEL_HEIGHT (f))}; +#ifdef HAVE_GTK3 + GObjectClass *object_class; + GtkWidgetClass *class; #endif if (!FRAME_DISPLAY_INFO (f)->alpha_bits) @@ -3754,6 +3957,21 @@ x_update_opaque_region (struct frame *f, XEvent *configure) FRAME_DISPLAY_INFO (f)->Xatom_net_wm_opaque_region, XA_CARDINAL, 32, PropModeReplace, (unsigned char *) &opaque_region, 4); +#else + else if (FRAME_TOOLTIP_P (f)) + 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); + else + { + object_class = G_OBJECT_GET_CLASS (FRAME_GTK_OUTER_WIDGET (f)); + class = GTK_WIDGET_CLASS (object_class); + + if (class->style_updated) + class->style_updated (FRAME_GTK_OUTER_WIDGET (f)); + } #endif unblock_input (); } @@ -3869,8 +4087,7 @@ xi_populate_device_from_info (struct xi_device_t *xi_device, xi_device->touchpoints = NULL; #endif - xi_device->master_p = (device->use == XIMasterKeyboard - || device->use == XIMasterPointer); + xi_device->use = device->use; #ifdef HAVE_XINPUT2_2 xi_device->direct_p = false; #endif @@ -4920,9 +5137,14 @@ x_clear_window (struct frame *f) x_end_cr_clip (f); #else #ifndef USE_GTK - if (FRAME_X_DOUBLE_BUFFERED_P (f) || (f->alpha_background != 1.0)) + if (f->alpha_background != 1.0 +#ifdef HAVE_XDBE + || FRAME_X_DOUBLE_BUFFERED_P (f) +#endif + ) #endif - x_clear_area (f, 0, 0, FRAME_PIXEL_WIDTH (f), FRAME_PIXEL_HEIGHT (f)); + x_clear_area (f, 0, 0, FRAME_PIXEL_WIDTH (f), + FRAME_PIXEL_HEIGHT (f)); #ifndef USE_GTK else XClearWindow (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f)); @@ -5249,13 +5471,15 @@ x_draw_window_divider (struct window *w, int x0, int x1, int y0, int y1) /* Show the frame back buffer. If frame is double-buffered, atomically publish to the user's screen graphics updates made since the last call to show_back_buffer. */ + +#ifdef HAVE_XDBE static void show_back_buffer (struct frame *f) { block_input (); + if (FRAME_X_DOUBLE_BUFFERED_P (f)) { -#ifdef HAVE_XDBE #ifdef USE_CAIRO cairo_t *cr = FRAME_CR_CONTEXT (f); if (cr) @@ -5266,13 +5490,12 @@ show_back_buffer (struct frame *f) swap_info.swap_window = FRAME_X_WINDOW (f); swap_info.swap_action = XdbeCopied; XdbeSwapBuffers (FRAME_X_DISPLAY (f), &swap_info, 1); -#else - eassert (!"should have back-buffer only with XDBE"); -#endif } FRAME_X_NEED_BUFFER_FLIP (f) = false; + unblock_input (); } +#endif /* Updates back buffer and flushes changes to display. Called from minibuf read code. Note that we display the back buffer even if @@ -5281,8 +5504,10 @@ static void x_flip_and_flush (struct frame *f) { block_input (); +#ifdef HAVE_XDBE if (FRAME_X_NEED_BUFFER_FLIP (f)) - show_back_buffer (f); + show_back_buffer (f); +#endif x_flush (f); unblock_input (); } @@ -5331,8 +5556,12 @@ XTframe_up_to_date (struct frame *f) eassert (FRAME_X_P (f)); block_input (); FRAME_MOUSE_UPDATE (f); - if (!buffer_flipping_blocked_p () && FRAME_X_NEED_BUFFER_FLIP (f)) + +#ifdef HAVE_XDBE + if (!buffer_flipping_blocked_p () + && FRAME_X_NEED_BUFFER_FLIP (f)) show_back_buffer (f); +#endif #ifdef HAVE_XSYNC #ifndef HAVE_GTK3 @@ -5385,12 +5614,14 @@ XTframe_up_to_date (struct frame *f) unblock_input (); } +#ifdef HAVE_XDBE static void XTbuffer_flipping_unblocked_hook (struct frame *f) { if (FRAME_X_NEED_BUFFER_FLIP (f)) show_back_buffer (f); } +#endif /** * x_clear_under_internal_border: @@ -5813,7 +6044,10 @@ x_set_cursor_gc (struct glyph_string *s) IF_DEBUG (x_check_font (s->f, s->font)); xgcv.graphics_exposures = False; - mask = GCForeground | GCBackground | GCGraphicsExposures; + xgcv.line_width = 1; + mask = (GCForeground | GCBackground + | GCGraphicsExposures + | GCLineWidth); if (FRAME_DISPLAY_INFO (s->f)->scratch_cursor_gc) XChangeGC (display, FRAME_DISPLAY_INFO (s->f)->scratch_cursor_gc, @@ -5845,7 +6079,11 @@ x_set_mouse_face_gc (struct glyph_string *s) xgcv.background = s->face->background; xgcv.foreground = s->face->foreground; xgcv.graphics_exposures = False; - mask = GCForeground | GCBackground | GCGraphicsExposures; + xgcv.line_width = 1; + + mask = (GCForeground | GCBackground + | GCGraphicsExposures + | GCLineWidth); if (FRAME_DISPLAY_INFO (s->f)->scratch_cursor_gc) XChangeGC (display, FRAME_DISPLAY_INFO (s->f)->scratch_cursor_gc, @@ -6666,6 +6904,21 @@ x_query_frame_background_color (struct frame *f, XColor *bgcolor) x_query_colors (f, bgcolor, 1); } +static unsigned int +x_hash_string_ignore_case (const char *string) +{ + unsigned int i; + + i = 3323198485ul; + for (; *string; ++string) + { + i ^= c_tolower (*string); + i *= 0x5bd1e995; + i ^= i >> 15; + } + return i; +} + /* On frame F, translate the color name to RGB values. Use cached information, if possible. @@ -6678,12 +6931,18 @@ Status x_parse_color (struct frame *f, const char *color_name, XColor *color) { + unsigned short r, g, b; + Display *dpy = FRAME_X_DISPLAY (f); + Colormap cmap = FRAME_X_COLORMAP (f); + struct x_display_info *dpyinfo; + struct color_name_cache_entry *cache_entry; + unsigned int hash, idx; + /* Don't pass #RGB strings directly to XParseColor, because that follows the X convention of zero-extending each channel value: #f00 means #f00000. We want the convention of scaling channel values, so #f00 means #ff0000, just as it does for HTML, SVG, and CSS. */ - unsigned short r, g, b; if (parse_color_spec (color_name, &r, &g, &b)) { color->red = r; @@ -6692,13 +6951,14 @@ x_parse_color (struct frame *f, const char *color_name, return 1; } - Display *dpy = FRAME_X_DISPLAY (f); - Colormap cmap = FRAME_X_COLORMAP (f); - struct color_name_cache_entry *cache_entry; - for (cache_entry = FRAME_DISPLAY_INFO (f)->color_names; cache_entry; - cache_entry = cache_entry->next) + dpyinfo = FRAME_DISPLAY_INFO (f); + hash = x_hash_string_ignore_case (color_name); + idx = hash % dpyinfo->color_names_size; + + for (cache_entry = FRAME_DISPLAY_INFO (f)->color_names[idx]; + cache_entry; cache_entry = cache_entry->next) { - if (!xstrcasecmp(cache_entry->name, color_name)) + if (!xstrcasecmp (cache_entry->name, color_name)) { *color = cache_entry->rgb; return 1; @@ -6716,8 +6976,8 @@ x_parse_color (struct frame *f, const char *color_name, cache_entry = xzalloc (sizeof *cache_entry); cache_entry->rgb = *color; cache_entry->name = xstrdup (color_name); - cache_entry->next = FRAME_DISPLAY_INFO (f)->color_names; - FRAME_DISPLAY_INFO (f)->color_names = cache_entry; + cache_entry->next = FRAME_DISPLAY_INFO (f)->color_names[idx]; + FRAME_DISPLAY_INFO (f)->color_names[idx] = cache_entry; return 1; } @@ -6971,7 +7231,7 @@ x_alloc_lighter_color (struct frame *f, Display *display, Colormap cmap, that scaling by FACTOR alone isn't enough. */ { /* How far below the limit this color is (0 - 1, 1 being darker). */ - double dimness = 1 - (double)bright / HIGHLIGHT_COLOR_DARK_BOOST_LIMIT; + double dimness = 1 - (double) bright / HIGHLIGHT_COLOR_DARK_BOOST_LIMIT; /* The additive adjustment. */ int min_delta = delta * dimness * factor / 2; @@ -7992,7 +8252,7 @@ x_draw_stretch_glyph_string (struct glyph_string *s) } static void -x_get_scale_factor(Display *disp, int *scale_x, int *scale_y) +x_get_scale_factor (Display *disp, int *scale_x, int *scale_y) { const int base_res = 96; struct x_display_info * dpyinfo = x_display_info_for_display (disp); @@ -8487,8 +8747,11 @@ x_clear_area (struct frame *f, int x, int y, int width, int height) x_end_cr_clip (f); #else #ifndef USE_GTK - if (FRAME_X_DOUBLE_BUFFERED_P (f) - || f->alpha_background != 1.0) + if (f->alpha_background != 1.0 +#ifdef HAVE_XDBE + || FRAME_X_DOUBLE_BUFFERED_P (f) +#endif + ) #endif { #if defined HAVE_XRENDER && \ @@ -8652,6 +8915,8 @@ XTflash (struct frame *f) { GC gc; XGCValues values; + fd_set fds; + int fd, rc; block_input (); @@ -8702,6 +8967,7 @@ XTflash (struct frame *f) struct timespec delay = make_timespec (0, 150 * 1000 * 1000); struct timespec wakeup = timespec_add (current_timespec (), delay); + fd = ConnectionNumber (FRAME_X_DISPLAY (f)); /* Keep waiting until past the time wakeup or any input gets available. */ @@ -8717,8 +8983,17 @@ XTflash (struct frame *f) /* How long `select' should wait. */ timeout = make_timespec (0, 10 * 1000 * 1000); + /* Wait for some input to become available on the X + connection. */ + FD_ZERO (&fds); + FD_SET (fd, &fds); + /* Try to wait that long--but we might wake up sooner. */ - pselect (0, NULL, NULL, NULL, &timeout, NULL); + rc = pselect (fd + 1, &fds, NULL, NULL, &timeout, NULL); + + /* Some input is available, exit the visible bell. */ + if (rc >= 0 && FD_ISSET (fd, &fds)) + break; } /* If window is tall, flash top and bottom line. */ @@ -8748,16 +9023,6 @@ XTflash (struct frame *f) unblock_input (); } - -static void -XTtoggle_invisible_pointer (struct frame *f, bool invisible) -{ - block_input (); - FRAME_DISPLAY_INFO (f)->toggle_visible_pointer (f, invisible); - unblock_input (); -} - - /* Make audible bell. */ static void @@ -8929,11 +9194,13 @@ x_scroll_run (struct window *w, struct run *run) } #endif +#ifdef USE_CAIRO_XCB_SURFACE /* Some of the following code depends on `normal_gc' being up-to-date on the X server, but doesn't call a routine that will flush it first. So do this ourselves instead. */ XFlushGC (FRAME_X_DISPLAY (f), f->output_data.x->normal_gc); +#endif #ifdef USE_CAIRO if (FRAME_CR_CONTEXT (f)) @@ -9055,6 +9322,20 @@ static void x_new_focus_frame (struct x_display_info *dpyinfo, struct frame *frame) { struct frame *old_focus = dpyinfo->x_focus_frame; +#if defined USE_GTK && !defined HAVE_GTK3 && defined HAVE_XINPUT2 + XIEventMask mask; + ptrdiff_t l; + + if (dpyinfo->supports_xi2) + { + l = XIMaskLen (XI_LASTEVENT); + mask.mask = alloca (l); + mask.mask_len = l; + memset (mask.mask, 0, l); + + mask.deviceid = XIAllDevices; + } +#endif if (frame != dpyinfo->x_focus_frame) { @@ -9062,6 +9343,17 @@ x_new_focus_frame (struct x_display_info *dpyinfo, struct frame *frame) the correct value of x_focus_frame. */ dpyinfo->x_focus_frame = frame; + /* Once none of our frames are focused anymore, stop selecting + for raw input events from the root window. */ + +#if defined USE_GTK && !defined HAVE_GTK3 && defined HAVE_XINPUT2 + if (frame && dpyinfo->supports_xi2) + XISetMask (mask.mask, XI_RawKeyPress); + + if (dpyinfo->supports_xi2) + XISelectEvents (dpyinfo->display, dpyinfo->root_window, &mask, 1); +#endif + if (old_focus && old_focus->auto_lower) x_lower_frame (old_focus); @@ -9074,6 +9366,105 @@ x_new_focus_frame (struct x_display_info *dpyinfo, struct frame *frame) x_frame_rehighlight (dpyinfo); } +/* True if the display in DPYINFO supports a version of Xfixes + sufficient for pointer blanking. */ +#ifdef HAVE_XFIXES +static bool +x_probe_xfixes_extension (struct x_display_info *dpyinfo) +{ + return (dpyinfo->xfixes_supported_p + && dpyinfo->xfixes_major >= 4); +} +#endif /* HAVE_XFIXES */ + +/* Toggle mouse pointer visibility on frame F using the XFixes + extension. */ +#ifdef HAVE_XFIXES +static void +xfixes_toggle_visible_pointer (struct frame *f, bool invisible) + +{ + if (invisible) + XFixesHideCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f)); + else + XFixesShowCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f)); + f->pointer_invisible = invisible; +} +#endif /* HAVE_XFIXES */ + +/* Create invisible cursor on the X display referred by DPYINFO. */ +static Cursor +make_invisible_cursor (struct x_display_info *dpyinfo) +{ + Display *dpy = dpyinfo->display; + static char const no_data[] = { 0 }; + Pixmap pix; + XColor col; + Cursor c; + + c = None; + + x_catch_errors (dpy); + pix = XCreateBitmapFromData (dpy, dpyinfo->root_window, no_data, 1, 1); + if (!x_had_errors_p (dpy) && pix != None) + { + Cursor pixc; + col.pixel = 0; + col.red = col.green = col.blue = 0; + col.flags = DoRed | DoGreen | DoBlue; + pixc = XCreatePixmapCursor (dpy, pix, pix, &col, &col, 0, 0); + if (! x_had_errors_p (dpy) && pixc != None) + c = pixc; + XFreePixmap (dpy, pix); + } + + x_uncatch_errors (); + + return c; +} + +/* Toggle mouse pointer visibility on frame F by using an invisible + cursor. */ +static void +x_toggle_visible_pointer (struct frame *f, bool invisible) +{ + struct x_display_info *dpyinfo; + + dpyinfo = FRAME_DISPLAY_INFO (f); + + /* We could have gotten a BadAlloc error while creating the + invisible cursor. Try to create it again, but if that fails, + just give up. */ + if (dpyinfo->invisible_cursor == None) + dpyinfo->invisible_cursor = make_invisible_cursor (dpyinfo); + + if (dpyinfo->invisible_cursor == None) + invisible = false; + + if (invisible) + XDefineCursor (dpyinfo->display, FRAME_X_WINDOW (f), + dpyinfo->invisible_cursor); + else + XDefineCursor (dpyinfo->display, FRAME_X_WINDOW (f), + f->output_data.x->current_cursor); + + f->pointer_invisible = invisible; +} + +static void +XTtoggle_invisible_pointer (struct frame *f, bool invisible) +{ + block_input (); +#ifdef HAVE_XFIXES + if (FRAME_DISPLAY_INFO (f)->fixes_pointer_blanking + && x_probe_xfixes_extension (FRAME_DISPLAY_INFO (f))) + xfixes_toggle_visible_pointer (f, invisible); + else +#endif + x_toggle_visible_pointer (f, invisible); + unblock_input (); +} + /* Handle FocusIn and FocusOut state changes for FRAME. If FRAME has focus and there exists more than one frame, puts a FOCUS_IN_EVENT into *BUFP. */ @@ -9346,8 +9737,54 @@ x_top_window_to_frame (struct x_display_info *dpyinfo, int wdesc) return x_window_to_frame (dpyinfo, wdesc); } +static void +x_next_event_from_any_display (XEvent *event) +{ + struct x_display_info *dpyinfo; + fd_set fds; + int fd, maxfd; + + while (true) + { + FD_ZERO (&fds); + maxfd = -1; + + for (dpyinfo = x_display_list; dpyinfo; + dpyinfo = dpyinfo->next) + { + if (XPending (dpyinfo->display)) + { + XNextEvent (dpyinfo->display, event); + return; + } + + fd = XConnectionNumber (dpyinfo->display); + + if (fd > maxfd) + maxfd = fd; + + eassert (fd < FD_SETSIZE); + FD_SET (XConnectionNumber (dpyinfo->display), &fds); + } + + eassert (maxfd >= 0); + + /* We don't have to check the return of pselect, because if an + error occurs XPending will call the IO error handler, which + then brings us out of this loop. */ + pselect (maxfd, &fds, NULL, NULL, NULL, NULL); + } +} + #endif /* USE_X_TOOLKIT || USE_GTK */ +static void +x_clear_dnd_targets (void) +{ + if (x_dnd_unwind_flag) + x_set_dnd_targets (NULL, 0); +} + /* This function is defined far away from the rest of the XDND code so it can utilize `x_any_window_to_frame'. */ @@ -9371,6 +9808,13 @@ x_dnd_begin_drag_and_drop (struct frame *f, Time time, Atom xaction, XTextProperty prop; xm_drop_start_message dmsg; Lisp_Object frame_object, x, y, frame, local_value; + bool signals_were_pending; +#ifdef HAVE_XKB + XkbStateRec keyboard_state; +#endif +#ifndef USE_GTK + struct x_display_info *event_display; +#endif if (!FRAME_VISIBLE_P (f)) { @@ -9389,8 +9833,16 @@ x_dnd_begin_drag_and_drop (struct frame *f, Time time, Atom xaction, } if (CONSP (local_value)) - x_own_selection (QXdndSelection, - Fnth (make_fixnum (1), local_value), frame); + { + ref = SPECPDL_INDEX (); + + record_unwind_protect_void (x_clear_dnd_targets); + x_dnd_unwind_flag = true; + x_own_selection (QXdndSelection, + Fnth (make_fixnum (1), local_value), frame); + x_dnd_unwind_flag = false; + unbind_to (ref, Qnil); + } else { x_set_dnd_targets (NULL, 0); @@ -9481,6 +9933,20 @@ x_dnd_begin_drag_and_drop (struct frame *f, Time time, Atom xaction, x_dnd_toplevels = NULL; x_dnd_allow_current_frame = allow_current_frame; x_dnd_movement_frame = NULL; +#ifdef HAVE_XKB + x_dnd_keyboard_state = 0; + + if (FRAME_DISPLAY_INFO (f)->supports_xkb) + { + XkbSelectEvents (FRAME_X_DISPLAY (f), XkbUseCoreKbd, + XkbStateNotifyMask, XkbStateNotifyMask); + XkbGetState (FRAME_X_DISPLAY (f), XkbUseCoreKbd, + &keyboard_state); + + x_dnd_keyboard_state = (keyboard_state.mods + | keyboard_state.ptr_buttons); + } +#endif if (x_dnd_use_toplevels) { @@ -9497,15 +9963,10 @@ x_dnd_begin_drag_and_drop (struct frame *f, Time time, Atom xaction, if (EQ (return_frame, Qnow)) x_dnd_return_frame = 2; -#ifdef USE_GTK - current_count = 0; -#endif - /* Now select for SubstructureNotifyMask and PropertyNotifyMask on the root window, so we can get notified when window stacking changes, a common operation during drag-and-drop. */ - block_input (); XGetWindowAttributes (FRAME_X_DISPLAY (f), FRAME_DISPLAY_INFO (f)->root_window, &root_window_attrs); @@ -9525,40 +9986,55 @@ x_dnd_begin_drag_and_drop (struct frame *f, Time time, Atom xaction, #ifdef USE_GTK current_finish = X_EVENT_NORMAL; current_hold_quit = &hold_quit; + current_count = 0; #endif + block_input (); #ifdef USE_GTK gtk_main_iteration (); -#else -#ifdef USE_X_TOOLKIT +#elif defined USE_X_TOOLKIT XtAppNextEvent (Xt_app_con, &next_event); #else - XNextEvent (FRAME_X_DISPLAY (f), &next_event); + x_next_event_from_any_display (&next_event); #endif +#ifndef USE_GTK + event_display + = x_display_info_for_display (next_event.xany.display); + + if (event_display) + { #ifdef HAVE_X_I18N #ifdef HAVE_XINPUT2 - if (next_event.type != GenericEvent - || !FRAME_DISPLAY_INFO (f)->supports_xi2 - || (next_event.xgeneric.extension - != FRAME_DISPLAY_INFO (f)->xi2_opcode)) - { + if (next_event.type != GenericEvent + || !event_display->supports_xi2 + || (next_event.xgeneric.extension + != event_display->xi2_opcode)) + { #endif - if (!x_filter_event (FRAME_DISPLAY_INFO (f), &next_event)) - handle_one_xevent (FRAME_DISPLAY_INFO (f), - &next_event, &finish, &hold_quit); + if (!x_filter_event (event_display, &next_event)) + handle_one_xevent (event_display, + &next_event, &finish, &hold_quit); #ifdef HAVE_XINPUT2 - } - else - handle_one_xevent (FRAME_DISPLAY_INFO (f), - &next_event, &finish, &hold_quit); + } + else + handle_one_xevent (event_display, + &next_event, &finish, &hold_quit); #endif #else - handle_one_xevent (FRAME_DISPLAY_INFO (f), - &next_event, &finish, &hold_quit); + handle_one_xevent (event_display, + &next_event, &finish, &hold_quit); #endif + } #endif + /* The unblock_input below might try to read input, but + XTread_socket does nothing inside a drag-and-drop event + loop, so don't let it clear the pending_signals flag. */ + signals_were_pending = pending_signals; + unblock_input (); + pending_signals = signals_were_pending; + if (x_dnd_movement_frame) { XSETFRAME (frame_object, x_dnd_movement_frame); @@ -9658,7 +10134,15 @@ x_dnd_begin_drag_and_drop (struct frame *f, Time time, Atom xaction, XSelectInput (FRAME_X_DISPLAY (f), FRAME_DISPLAY_INFO (f)->root_window, root_window_attrs.your_event_mask); - unblock_input (); +#ifdef HAVE_XKB + if (FRAME_DISPLAY_INFO (f)->supports_xkb) + XkbSelectEvents (FRAME_X_DISPLAY (f), XkbUseCoreKbd, + XkbStateNotifyMask, 0); +#endif + /* Delete the Motif drag initiator info if it was set up. */ + if (x_dnd_motif_setup_p) + XDeleteProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), + FRAME_DISPLAY_INFO (f)->Xatom_XdndSelection); quit (); } } @@ -9671,11 +10155,20 @@ x_dnd_begin_drag_and_drop (struct frame *f, Time time, Atom xaction, #endif x_dnd_movement_frame = NULL; + block_input (); /* Restore the old event mask. */ XSelectInput (FRAME_X_DISPLAY (f), FRAME_DISPLAY_INFO (f)->root_window, root_window_attrs.your_event_mask); - +#ifdef HAVE_XKB + if (FRAME_DISPLAY_INFO (f)->supports_xkb) + XkbSelectEvents (FRAME_X_DISPLAY (f), XkbUseCoreKbd, + XkbStateNotifyMask, 0); +#endif + /* Delete the Motif drag initiator info if it was set up. */ + if (x_dnd_motif_setup_p) + XDeleteProperty (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), + FRAME_DISPLAY_INFO (f)->Xatom_XdndSelection); unblock_input (); if (x_dnd_return_frame == 3 @@ -9712,10 +10205,18 @@ x_dnd_begin_drag_and_drop (struct frame *f, Time time, Atom xaction, if (x_dnd_action != None) { block_input (); + x_catch_errors (FRAME_X_DISPLAY (f)); atom_name = XGetAtomName (FRAME_X_DISPLAY (f), x_dnd_action); - action = intern (atom_name); - XFree (atom_name); + x_uncatch_errors (); + + if (atom_name) + { + action = intern (atom_name); + XFree (atom_name); + } + else + action = Qnil; unblock_input (); return action; @@ -10432,6 +10933,16 @@ XTmouse_position (struct frame **fp, int insist, Lisp_Object *bar_window, #endif /* USE_X_TOOLKIT */ } + /* Set last user time to avoid confusing some window managers + about the tooltip displayed during drag-and-drop. */ + + if ((EQ (track_mouse, Qdrag_source) + || EQ (track_mouse, Qdropping)) + && (dpyinfo->last_user_time + < dpyinfo->last_mouse_movement_time)) + x_display_set_last_user_time (dpyinfo, + dpyinfo->last_mouse_movement_time); + if ((!f1 || FRAME_TOOLTIP_P (f1)) && (EQ (track_mouse, Qdropping) || EQ (track_mouse, Qdrag_source)) @@ -10720,6 +11231,35 @@ xt_horizontal_action_hook (Widget widget, XtPointer client_data, String action_n } #endif /* not USE_GTK */ +/* Protect WINDOW from garbage collection until a matching scroll bar + message is received. Return whether or not protection + succeeded. */ +static bool +x_protect_window_for_callback (struct x_display_info *dpyinfo, + Lisp_Object window) +{ + if (dpyinfo->n_protected_windows + 1 + >= dpyinfo->protected_windows_max) + return false; + + dpyinfo->protected_windows[dpyinfo->n_protected_windows++] + = window; + return true; +} + +static void +x_unprotect_window_for_callback (struct x_display_info *dpyinfo) +{ + if (!dpyinfo->n_protected_windows) + emacs_abort (); + + dpyinfo->n_protected_windows--; + + if (dpyinfo->n_protected_windows) + memmove (dpyinfo->protected_windows, &dpyinfo->protected_windows[1], + sizeof (Lisp_Object) * dpyinfo->n_protected_windows); +} + /* Send a client message with message type Xatom_Scrollbar for a scroll action to the frame of WINDOW. PART is a value identifying the part of the scroll bar that was clicked on. PORTION is the @@ -10737,8 +11277,12 @@ x_send_scroll_bar_event (Lisp_Object window, enum scroll_bar_part part, verify (INTPTR_WIDTH <= 64); int sign_shift = INTPTR_WIDTH - 32; - block_input (); + /* Don't do anything if too many scroll bar events have been + sent but not received. */ + if (!x_protect_window_for_callback (FRAME_DISPLAY_INFO (f), window)) + return; + block_input (); /* Construct a ClientMessage event to send to the frame. */ ev->type = ClientMessage; ev->message_type = (horizontal @@ -12614,6 +13158,22 @@ x_scroll_bar_expose (struct scroll_bar *bar, const XEvent *event) #else Drawable w = bar->x_drawable; #endif + int x, y, width, height; + + if (event->type == Expose) + { + x = event->xexpose.x; + y = event->xexpose.y; + width = event->xexpose.width; + height = event->xexpose.height; + } + else + { + x = event->xgraphicsexpose.x; + y = event->xgraphicsexpose.y; + width = event->xgraphicsexpose.width; + height = event->xgraphicsexpose.height; + } struct frame *f = XFRAME (WINDOW_FRAME (XWINDOW (bar->window))); GC gc = f->output_data.x->normal_gc; @@ -12632,10 +13192,7 @@ x_scroll_bar_expose (struct scroll_bar *bar, const XEvent *event) XFillRectangle (FRAME_X_DISPLAY (f), bar->x_drawable, - gc, event->xexpose.x, - event->xexpose.y, - event->xexpose.width, - event->xexpose.height); + gc, x, y, width, height); XSetForeground (FRAME_X_DISPLAY (f), gc, FRAME_FOREGROUND_PIXEL (f)); @@ -12647,15 +13204,18 @@ x_scroll_bar_expose (struct scroll_bar *bar, const XEvent *event) /* Switch to scroll bar foreground color. */ if (f->output_data.x->scroll_bar_foreground_pixel != -1) XSetForeground (FRAME_X_DISPLAY (f), gc, - f->output_data.x->scroll_bar_foreground_pixel); + f->output_data.x->scroll_bar_foreground_pixel); /* Draw a one-pixel border just inside the edges of the scroll bar. */ XDrawRectangle (FRAME_X_DISPLAY (f), w, gc, /* 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); + /* XDrawPoint (FRAME_X_DISPLAY (f), w, gc, + bar->width - 1, bar->height - 1); + + This code is no longer required since the normal GC now uses the + regular line width. */ /* Restore the foreground color of the GC if we changed it above. */ if (f->output_data.x->scroll_bar_foreground_pixel != -1) @@ -12681,8 +13241,14 @@ x_scroll_bar_expose (struct scroll_bar *bar, const XEvent *event) static void x_scroll_bar_handle_click (struct scroll_bar *bar, const XEvent *event, - struct input_event *emacs_event) + struct input_event *emacs_event, + Lisp_Object device) { + int left_range, x, top_range, y; +#ifndef USE_TOOLKIT_SCROLL_BARS + int new_start, new_end; +#endif + if (! WINDOWP (bar->window)) emacs_abort (); @@ -12700,11 +13266,15 @@ x_scroll_bar_handle_click (struct scroll_bar *bar, emacs_event->frame_or_window = bar->window; emacs_event->arg = Qnil; emacs_event->timestamp = event->xbutton.time; + + if (!NILP (device)) + emacs_event->device = device; + if (bar->horizontal) { - int left_range - = HORIZONTAL_SCROLL_BAR_LEFT_RANGE (f, bar->width); - int x = event->xbutton.x - HORIZONTAL_SCROLL_BAR_LEFT_BORDER; + + left_range = HORIZONTAL_SCROLL_BAR_LEFT_RANGE (f, bar->width); + x = event->xbutton.x - HORIZONTAL_SCROLL_BAR_LEFT_BORDER; if (x < 0) x = 0; if (x > left_range) x = left_range; @@ -12720,8 +13290,8 @@ x_scroll_bar_handle_click (struct scroll_bar *bar, /* If the user has released the handle, set it to its final position. */ if (event->type == ButtonRelease && bar->dragging != -1) { - int new_start = - bar->dragging; - int new_end = new_start + bar->end - bar->start; + new_start = - bar->dragging; + new_end = new_start + bar->end - bar->start; x_scroll_bar_set_handle (bar, new_start, new_end, false); bar->dragging = -1; @@ -12733,9 +13303,9 @@ x_scroll_bar_handle_click (struct scroll_bar *bar, } else { - int top_range + top_range = VERTICAL_SCROLL_BAR_TOP_RANGE (f, bar->height); - int y = event->xbutton.y - VERTICAL_SCROLL_BAR_TOP_BORDER; + y = event->xbutton.y - VERTICAL_SCROLL_BAR_TOP_BORDER; if (y < 0) y = 0; if (y > top_range) y = top_range; @@ -12751,8 +13321,8 @@ x_scroll_bar_handle_click (struct scroll_bar *bar, /* If the user has released the handle, set it to its final position. */ if (event->type == ButtonRelease && bar->dragging != -1) { - int new_start = y - bar->dragging; - int new_end = new_start + bar->end - bar->start; + new_start = y - bar->dragging; + new_end = new_start + bar->end - bar->start; x_scroll_bar_set_handle (bar, new_start, new_end, false); bar->dragging = -1; @@ -13228,20 +13798,20 @@ x_net_wm_state (struct frame *f, Window window) store_frame_param (f, Qshaded, shaded ? Qt : Qnil); } -/* Flip back buffers on FRAME if it has undrawn content. */ +/* Flip back buffers on F if it has undrawn content. */ + +#ifdef HAVE_XDBE static void flush_dirty_back_buffer_on (struct frame *f) { block_input (); - if (FRAME_LIVE_P (f) && - FRAME_X_P (f) && - FRAME_X_WINDOW (f) && - !FRAME_GARBAGED_P (f) && - !buffer_flipping_blocked_p () && - FRAME_X_NEED_BUFFER_FLIP (f)) + if (!FRAME_GARBAGED_P (f) + && !buffer_flipping_blocked_p () + && FRAME_X_NEED_BUFFER_FLIP (f)) show_back_buffer (f); unblock_input (); } +#endif #ifdef HAVE_GTK3 void @@ -13430,7 +14000,13 @@ x_dnd_update_state (struct x_display_info *dpyinfo, Time timestamp) x_dnd_last_protocol_version, root_x, root_y, x_dnd_selection_timestamp, - x_dnd_wanted_action); + x_dnd_wanted_action, 0, +#ifdef HAVE_XKB + x_dnd_keyboard_state +#else + 0 +#endif + ); else if (XM_DRAG_STYLE_IS_DYNAMIC (x_dnd_last_motif_style) && target != None) { if (!x_dnd_motif_setup_p) @@ -13533,10 +14109,10 @@ handle_one_xevent (struct x_display_info *dpyinfo, XEvent configureEvent; XEvent next_event; Lisp_Object coding; -#if defined USE_MOTIF && defined HAVE_XINPUT2 - /* Some XInput 2 events are important for Motif menu bars to work - correctly, so they must be translated into core events before - being passed to XtDispatchEvent. */ +#if defined USE_X_TOOLKIT && defined HAVE_XINPUT2 + /* Some XInput 2 events are important for Motif and Lucid menu bars + to work correctly, so they must be translated into core events + before being passed to XtDispatchEvent. */ bool use_copy = false; XEvent copy; #elif defined USE_GTK && !defined HAVE_GTK3 && defined HAVE_XINPUT2 @@ -13613,6 +14189,10 @@ handle_one_xevent (struct x_display_info *dpyinfo, if (event->xclient.message_type == dpyinfo->Xatom_XdndFinished && (x_dnd_waiting_for_finish && !x_dnd_waiting_for_motif_finish) + /* Also check that the display is correct, since + `x_dnd_pending_finish_target' could still be valid on + another X server. */ + && dpyinfo->display == x_dnd_finish_display && event->xclient.data.l[0] == x_dnd_pending_finish_target) { x_dnd_waiting_for_finish = false; @@ -13629,12 +14209,9 @@ handle_one_xevent (struct x_display_info *dpyinfo, if ((event->xclient.message_type == dpyinfo->Xatom_MOTIF_DRAG_AND_DROP_MESSAGE) - /* FIXME: There should probably be a check that the event - comes from the same display where the drop event was - sent, but there's no way to get that information here - safely. */ && x_dnd_waiting_for_finish - && x_dnd_waiting_for_motif_finish == 1) + && x_dnd_waiting_for_motif_finish == 1 + && dpyinfo == x_dnd_waiting_for_motif_finish_display) { xm_drop_start_reply reply; uint16_t operation, status, action; @@ -13877,9 +14454,13 @@ handle_one_xevent (struct x_display_info *dpyinfo, { f = any; if (f) - _XEditResCheckMessages (f->output_data.x->widget, - NULL, (XEvent *) event, NULL); - goto done; + { + _XEditResCheckMessages (f->output_data.x->widget, + NULL, (XEvent *) event, NULL); + goto done; + } + + goto OTHER; } #endif /* X_TOOLKIT_EDITRES */ @@ -13992,6 +14573,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, if (x_dnd_waiting_for_finish && x_dnd_waiting_for_motif_finish == 2 + && dpyinfo == x_dnd_waiting_for_motif_finish_display && eventp->selection == dpyinfo->Xatom_XdndSelection && (eventp->target == dpyinfo->Xatom_XmTRANSFER_SUCCESS || eventp->target == dpyinfo->Xatom_XmTRANSFER_FAILURE)) @@ -14060,7 +14642,9 @@ handle_one_xevent (struct x_display_info *dpyinfo, } f = x_top_window_to_frame (dpyinfo, event->xproperty.window); - if (f && event->xproperty.atom == dpyinfo->Xatom_net_wm_state) + if (f && event->xproperty.atom == dpyinfo->Xatom_net_wm_state + /* This should never happen with embedded windows. */ + && !FRAME_X_EMBEDDED_P (f)) { bool not_hidden = x_handle_net_wm_state (f, &event->xproperty); @@ -14186,8 +14770,10 @@ handle_one_xevent (struct x_display_info *dpyinfo, SET_FRAME_ICONIFIED (f, false); } +#ifdef HAVE_XDBE if (FRAME_X_DOUBLE_BUFFERED_P (f)) x_drop_xrender_surfaces (f); +#endif f->output_data.x->has_been_visible = true; SET_FRAME_GARBAGED (f); unblock_input (); @@ -14212,6 +14798,12 @@ handle_one_xevent (struct x_display_info *dpyinfo, if (!FRAME_GARBAGED_P (f)) { +#ifdef USE_X_TOOLKIT + if (f->output_data.x->edit_widget) + /* The widget's expose proc will be run in this + case. */ + goto OTHER; +#endif #ifdef USE_GTK /* This seems to be needed for GTK 2.6 and later, see https://debbugs.gnu.org/cgi/bugreport.cgi?bug=15398. */ @@ -14226,8 +14818,10 @@ handle_one_xevent (struct x_display_info *dpyinfo, #endif } +#ifdef HAVE_XDBE if (!FRAME_GARBAGED_P (f)) show_back_buffer (f); +#endif } else { @@ -14275,8 +14869,20 @@ handle_one_xevent (struct x_display_info *dpyinfo, #ifdef USE_GTK x_clear_under_internal_border (f); #endif +#ifdef HAVE_XDBE show_back_buffer (f); +#endif } +#ifndef USE_TOOLKIT_SCROLL_BARS + struct scroll_bar *bar + = x_window_to_scroll_bar (dpyinfo->display, + /* Hopefully this is just a window, + not the back buffer. */ + event->xgraphicsexpose.drawable, 2); + + if (bar) + x_scroll_bar_expose (bar, event); +#endif #ifdef USE_X_TOOLKIT else goto OTHER; @@ -14319,6 +14925,34 @@ handle_one_xevent (struct x_display_info *dpyinfo, { bool visible = FRAME_VISIBLE_P (f); +#ifdef USE_LUCID + /* Bloodcurdling hack alert: The Lucid menu bar widget's + redisplay procedure is not called when a tip frame over + menu items is unmapped. Redisplay the menu manually... */ + if (FRAME_TOOLTIP_P (f) && popup_activated ()) + { + Widget w; + Lisp_Object tail, frame; + struct frame *f1; + + FOR_EACH_FRAME (tail, frame) + { + if (!FRAME_X_P (XFRAME (frame))) + continue; + + f1 = XFRAME (frame); + + if (FRAME_LIVE_P (f1)) + { + w = FRAME_X_OUTPUT (f1)->menubar_widget; + + if (w && !DoesSaveUnders (FRAME_DISPLAY_INFO (f1)->screen)) + xlwmenu_redisplay (w); + } + } + } +#endif /* USE_LUCID */ + /* While a frame is unmapped, display generation is disabled; you don't want to spend time updating a display that won't ever be seen. */ @@ -14417,7 +15051,9 @@ handle_one_xevent (struct x_display_info *dpyinfo, x_set_z_group (f, Qbelow, Qnil); } - if (not_hidden) + /* Embedded frames might have NET_WM_STATE left over, but + are always visible once mapped. */ + if (not_hidden || FRAME_X_EMBEDDED_P (f)) { SET_FRAME_VISIBLE (f, 1); SET_FRAME_ICONIFIED (f, false); @@ -14436,7 +15072,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, x_update_opaque_region (f, NULL); - if (not_hidden && iconified) + if ((not_hidden || FRAME_X_EMBEDDED_P (f)) && iconified) { inev.ie.kind = DEICONIFY_EVENT; XSETFRAME (inev.ie.frame_or_window, f); @@ -14636,19 +15272,19 @@ handle_one_xevent (struct x_display_info *dpyinfo, memset (&compose_status, 0, sizeof (compose_status)); orig_keysym = keysym; - /* Common for all keysym input events. */ - XSETFRAME (inev.ie.frame_or_window, f); - inev.ie.modifiers - = x_x_to_emacs_modifiers (FRAME_DISPLAY_INFO (f), modifiers); - inev.ie.timestamp = xkey.time; + /* Common for all keysym input events. */ + XSETFRAME (inev.ie.frame_or_window, f); + inev.ie.modifiers + = x_x_to_emacs_modifiers (FRAME_DISPLAY_INFO (f), modifiers); + inev.ie.timestamp = xkey.time; - /* First deal with keysyms which have defined - translations to characters. */ - if (keysym >= 32 && keysym < 128) - /* Avoid explicitly decoding each ASCII character. */ - { - inev.ie.kind = ASCII_KEYSTROKE_EVENT; - inev.ie.code = keysym; + /* First deal with keysyms which have defined + translations to characters. */ + if (keysym >= 32 && keysym < 128) + /* Avoid explicitly decoding each ASCII character. */ + { + inev.ie.kind = ASCII_KEYSTROKE_EVENT; + inev.ie.code = keysym; #ifdef HAVE_XINPUT2 if (event->xkey.time == pending_keystroke_time) @@ -14693,7 +15329,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, Vx_keysym_table, Qnil), FIXNATP (c))) - { + { inev.ie.kind = (SINGLE_BYTE_CHAR_P (XFIXNAT (c)) ? ASCII_KEYSTROKE_EVENT : MULTIBYTE_CHAR_KEYSTROKE_EVENT); @@ -14710,11 +15346,11 @@ handle_one_xevent (struct x_display_info *dpyinfo, } #endif - goto done_keysym; - } + goto done_keysym; + } - /* Random non-modifier sorts of keysyms. */ - if (((keysym >= XK_BackSpace && keysym <= XK_Escape) + /* Random non-modifier sorts of keysyms. */ + if (((keysym >= XK_BackSpace && keysym <= XK_Escape) || keysym == XK_Delete #ifdef XK_ISO_Left_Tab || (keysym >= XK_ISO_Left_Tab @@ -14929,7 +15565,10 @@ handle_one_xevent (struct x_display_info *dpyinfo, f = any; if (f && x_mouse_click_focus_ignore_position) - ignore_next_mouse_click_timeout = event->xmotion.time + 200; + { + ignore_next_mouse_click_timeout = event->xmotion.time + 200; + mouse_click_timeout_display = dpyinfo; + } /* EnterNotify counts as mouse movement, so update things that depend on mouse position. */ @@ -15004,10 +15643,11 @@ handle_one_xevent (struct x_display_info *dpyinfo, #else f = x_top_window_to_frame (dpyinfo, event->xcrossing.window); #endif -#if defined USE_X_TOOLKIT && defined HAVE_XINPUT2 +#if defined USE_X_TOOLKIT && defined HAVE_XINPUT2 && !defined USE_MOTIF /* 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. */ + interested in. (But don't ignore this on Motif, since we + want to clear the mouse face when a popup is active.) */ if (dpyinfo->supports_xi2) f = NULL; #endif @@ -15203,7 +15843,8 @@ handle_one_xevent (struct x_display_info *dpyinfo, event->xmotion.x_root, event->xmotion.y_root, x_dnd_selection_timestamp, - x_dnd_wanted_action); + x_dnd_wanted_action, 0, + event->xmotion.state); else if (XM_DRAG_STYLE_IS_DYNAMIC (x_dnd_last_motif_style) && target != None) { if (!x_dnd_motif_setup_p) @@ -15454,8 +16095,10 @@ handle_one_xevent (struct x_display_info *dpyinfo, for size changes: that's not sufficient. We miss some surface invalidations and flicker. */ block_input (); +#ifdef HAVE_XDBE if (f && FRAME_X_DOUBLE_BUFFERED_P (f)) x_drop_xrender_surfaces (f); +#endif unblock_input (); #if defined USE_CAIRO && !defined USE_GTK if (f) @@ -15543,6 +16186,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, /* Even if the number of character rows and columns has not changed, the font size may have changed, so we need to check the pixel dimensions as well. */ + if (width != FRAME_PIXEL_WIDTH (f) || height != FRAME_PIXEL_HEIGHT (f) || (f->new_size_p @@ -15646,103 +16290,126 @@ handle_one_xevent (struct x_display_info *dpyinfo, if (x_dnd_in_progress && dpyinfo == FRAME_DISPLAY_INFO (x_dnd_frame)) { - for (int i = 1; i < 8; ++i) + if (event->xbutton.type == ButtonPress + && x_dnd_last_seen_window != None + && x_dnd_last_protocol_version != -1) { - if (i != event->xbutton.button - && event->xbutton.state & (Button1Mask << (i - 1))) - dnd_grab = true; + x_dnd_send_position (x_dnd_frame, + x_dnd_last_seen_window, + x_dnd_last_protocol_version, + event->xbutton.x_root, + event->xbutton.y_root, + x_dnd_selection_timestamp, + x_dnd_wanted_action, + event->xbutton.button, + event->xbutton.state); + + goto OTHER; } - if (!dnd_grab && event->xbutton.type == ButtonRelease) + if (event->xbutton.type == ButtonRelease) { - x_dnd_end_window = x_dnd_last_seen_window; - x_dnd_in_progress = false; - - if (x_dnd_last_seen_window != None - && x_dnd_last_protocol_version != -1) + for (int i = 1; i < 8; ++i) { - x_dnd_pending_finish_target = x_dnd_last_seen_window; - x_dnd_waiting_for_finish_proto = x_dnd_last_protocol_version; - - x_dnd_waiting_for_finish - = x_dnd_send_drop (x_dnd_frame, x_dnd_last_seen_window, - x_dnd_selection_timestamp, - x_dnd_last_protocol_version); + if (i != event->xbutton.button + && event->xbutton.state & (Button1Mask << (i - 1))) + dnd_grab = true; } - else if (x_dnd_last_seen_window != None) + + if (!dnd_grab) { - xm_drop_start_message dmsg; - xm_drag_receiver_info drag_receiver_info; - - if (!xm_read_drag_receiver_info (dpyinfo, x_dnd_last_seen_window, - &drag_receiver_info) - && drag_receiver_info.protocol_style != XM_DRAG_STYLE_NONE - && (x_dnd_allow_current_frame - || x_dnd_last_seen_window != FRAME_OUTER_WINDOW (x_dnd_frame))) + x_dnd_end_window = x_dnd_last_seen_window; + x_dnd_in_progress = false; + + if (x_dnd_last_seen_window != None + && x_dnd_last_protocol_version != -1) { - if (!x_dnd_motif_setup_p) - xm_setup_drag_info (dpyinfo, x_dnd_frame); + x_dnd_pending_finish_target = x_dnd_last_seen_window; + x_dnd_waiting_for_finish_proto = x_dnd_last_protocol_version; + + x_dnd_waiting_for_finish + = x_dnd_send_drop (x_dnd_frame, x_dnd_last_seen_window, + x_dnd_selection_timestamp, + x_dnd_last_protocol_version); + x_dnd_finish_display = dpyinfo->display; + } + else if (x_dnd_last_seen_window != None) + { + xm_drop_start_message dmsg; + xm_drag_receiver_info drag_receiver_info; + + if (!xm_read_drag_receiver_info (dpyinfo, x_dnd_last_seen_window, + &drag_receiver_info) + && drag_receiver_info.protocol_style != XM_DRAG_STYLE_NONE + && (x_dnd_allow_current_frame + || x_dnd_last_seen_window != FRAME_OUTER_WINDOW (x_dnd_frame))) + { + if (!x_dnd_motif_setup_p) + xm_setup_drag_info (dpyinfo, x_dnd_frame); - if (x_dnd_motif_setup_p) + if (x_dnd_motif_setup_p) + { + memset (&dmsg, 0, sizeof dmsg); + + dmsg.reason = XM_DRAG_REASON (XM_DRAG_ORIGINATOR_INITIATOR, + XM_DRAG_REASON_DROP_START); + dmsg.byte_order = XM_BYTE_ORDER_CUR_FIRST; + dmsg.side_effects + = XM_DRAG_SIDE_EFFECT (xm_side_effect_from_action (dpyinfo, + x_dnd_wanted_action), + XM_DROP_SITE_VALID, + xm_side_effect_from_action (dpyinfo, + x_dnd_wanted_action), + (!x_dnd_xm_use_help + ? XM_DROP_ACTION_DROP + : XM_DROP_ACTION_DROP_HELP)); + dmsg.timestamp = event->xbutton.time; + dmsg.x = event->xbutton.x_root; + dmsg.y = event->xbutton.y_root; + dmsg.index_atom = dpyinfo->Xatom_XdndSelection; + dmsg.source_window = FRAME_X_WINDOW (x_dnd_frame); + + if (!XM_DRAG_STYLE_IS_DROP_ONLY (drag_receiver_info.protocol_style)) + x_dnd_send_xm_leave_for_drop (FRAME_DISPLAY_INFO (x_dnd_frame), + x_dnd_frame, x_dnd_last_seen_window, + event->xbutton.time); + + xm_send_drop_message (dpyinfo, FRAME_X_WINDOW (x_dnd_frame), + x_dnd_last_seen_window, &dmsg); + + x_dnd_waiting_for_finish = true; + x_dnd_waiting_for_motif_finish_display = dpyinfo; + x_dnd_waiting_for_motif_finish = 1; + x_dnd_finish_display = dpyinfo->display; + } + } + else { - memset (&dmsg, 0, sizeof dmsg); - - dmsg.reason = XM_DRAG_REASON (XM_DRAG_ORIGINATOR_INITIATOR, - XM_DRAG_REASON_DROP_START); - dmsg.byte_order = XM_BYTE_ORDER_CUR_FIRST; - dmsg.side_effects - = XM_DRAG_SIDE_EFFECT (xm_side_effect_from_action (dpyinfo, - x_dnd_wanted_action), - XM_DROP_SITE_VALID, - xm_side_effect_from_action (dpyinfo, - x_dnd_wanted_action), - (!x_dnd_xm_use_help - ? XM_DROP_ACTION_DROP - : XM_DROP_ACTION_DROP_HELP)); - dmsg.timestamp = event->xbutton.time; - dmsg.x = event->xbutton.x_root; - dmsg.y = event->xbutton.y_root; - dmsg.index_atom = dpyinfo->Xatom_XdndSelection; - dmsg.source_window = FRAME_X_WINDOW (x_dnd_frame); - - if (!XM_DRAG_STYLE_IS_DROP_ONLY (drag_receiver_info.protocol_style)) - x_dnd_send_xm_leave_for_drop (FRAME_DISPLAY_INFO (x_dnd_frame), - x_dnd_frame, x_dnd_last_seen_window, - event->xbutton.time); - - xm_send_drop_message (dpyinfo, FRAME_X_WINDOW (x_dnd_frame), - x_dnd_last_seen_window, &dmsg); - - x_dnd_waiting_for_finish = true; - x_dnd_waiting_for_motif_finish = 1; + x_set_pending_dnd_time (event->xbutton.time); + x_dnd_send_unsupported_drop (dpyinfo, (x_dnd_last_seen_toplevel != None + ? x_dnd_last_seen_toplevel + : x_dnd_last_seen_window), + event->xbutton.x_root, event->xbutton.y_root, + event->xbutton.time); } } - else + else if (x_dnd_last_seen_toplevel != None) { x_set_pending_dnd_time (event->xbutton.time); - x_dnd_send_unsupported_drop (dpyinfo, (x_dnd_last_seen_toplevel != None - ? x_dnd_last_seen_toplevel - : x_dnd_last_seen_window), - event->xbutton.x_root, event->xbutton.y_root, + x_dnd_send_unsupported_drop (dpyinfo, x_dnd_last_seen_toplevel, + event->xbutton.x_root, + event->xbutton.y_root, event->xbutton.time); } - } - else if (x_dnd_last_seen_toplevel != None) - { - x_set_pending_dnd_time (event->xbutton.time); - x_dnd_send_unsupported_drop (dpyinfo, x_dnd_last_seen_toplevel, - event->xbutton.x_root, - event->xbutton.y_root, - event->xbutton.time); - } - x_dnd_last_protocol_version = -1; - x_dnd_last_motif_style = XM_DRAG_STYLE_NONE; - x_dnd_last_seen_window = None; - x_dnd_last_seen_toplevel = None; - x_dnd_frame = NULL; - x_set_dnd_targets (NULL, 0); + x_dnd_last_protocol_version = -1; + x_dnd_last_motif_style = XM_DRAG_STYLE_NONE; + x_dnd_last_seen_window = None; + x_dnd_last_seen_toplevel = None; + x_dnd_frame = NULL; + x_set_dnd_targets (NULL, 0); + } } goto OTHER; @@ -15787,7 +16454,8 @@ handle_one_xevent (struct x_display_info *dpyinfo, && event->xbutton.button < 9 && f) { - if (ignore_next_mouse_click_timeout) + if (ignore_next_mouse_click_timeout + && dpyinfo == mouse_click_timeout_display) { if (event->type == ButtonPress && event->xbutton.time > ignore_next_mouse_click_timeout) @@ -15856,7 +16524,8 @@ handle_one_xevent (struct x_display_info *dpyinfo, if (! popup_activated ()) #endif { - if (ignore_next_mouse_click_timeout) + if (ignore_next_mouse_click_timeout + && dpyinfo == mouse_click_timeout_display) { if (event->type == ButtonPress && event->xbutton.time > ignore_next_mouse_click_timeout) @@ -15888,12 +16557,12 @@ handle_one_xevent (struct x_display_info *dpyinfo, scroll bars. */ if (bar && event->xbutton.state & ControlMask) { - x_scroll_bar_handle_click (bar, event, &inev.ie); + x_scroll_bar_handle_click (bar, event, &inev.ie, Qnil); *finish = X_EVENT_DROP; } #else /* not USE_TOOLKIT_SCROLL_BARS */ if (bar) - x_scroll_bar_handle_click (bar, event, &inev.ie); + x_scroll_bar_handle_click (bar, event, &inev.ie, Qnil); #endif /* not USE_TOOLKIT_SCROLL_BARS */ } @@ -16153,7 +16822,10 @@ handle_one_xevent (struct x_display_info *dpyinfo, f = any; if (f && x_mouse_click_focus_ignore_position) - ignore_next_mouse_click_timeout = xi_event->time + 200; + { + ignore_next_mouse_click_timeout = xev->time + 200; + mouse_click_timeout_display = dpyinfo; + } /* EnterNotify counts as mouse movement, so update things that depend on mouse position. */ @@ -16309,6 +16981,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, xm_top_level_leave_message lmsg; xm_top_level_enter_message emsg; xm_drag_motion_message dmsg; + int dnd_state; source = xi_device_from_id (dpyinfo, xev->sourceid); @@ -16348,6 +17021,9 @@ handle_one_xevent (struct x_display_info *dpyinfo, double delta, scroll_unit; int scroll_height; Lisp_Object window; + struct scroll_bar *bar; + + bar = NULL; /* See the comment on top of x_init_master_valuators for more details on how @@ -16365,9 +17041,8 @@ handle_one_xevent (struct x_display_info *dpyinfo, if (!f) { #if defined USE_MOTIF || !defined USE_TOOLKIT_SCROLL_BARS - struct scroll_bar *bar - = x_window_to_scroll_bar (xi_event->display, - xev->event, 2); + bar = x_window_to_scroll_bar (dpyinfo->display, + xev->event, 2); if (bar) f = WINDOW_XFRAME (XWINDOW (bar->window)); @@ -16384,11 +17059,26 @@ handle_one_xevent (struct x_display_info *dpyinfo, #endif if (FRAME_X_WINDOW (f) != xev->event) - XTranslateCoordinates (dpyinfo->display, - xev->event, FRAME_X_WINDOW (f), - lrint (xev->event_x), - lrint (xev->event_y), - &real_x, &real_y, &dummy); + { + if (!bar) + bar = x_window_to_scroll_bar (dpyinfo->display, xev->event, 2); + + /* If this is a scroll bar, compute the + actual position directly to avoid an + extra roundtrip. */ + + if (bar) + { + real_x = lrint (xev->event_x + bar->left); + real_y = lrint (xev->event_y + bar->top); + } + else + XTranslateCoordinates (dpyinfo->display, + xev->event, FRAME_X_WINDOW (f), + lrint (xev->event_x), + lrint (xev->event_y), + &real_x, &real_y, &dummy); + } else { real_x = lrint (xev->event_x); @@ -16527,7 +17217,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, XSETFRAME (inev.ie.frame_or_window, f); } - if (source && source->name) + if (source && !NILP (source->name)) inev.ie.device = source->name; goto XI_OTHER; @@ -16727,11 +17417,26 @@ handle_one_xevent (struct x_display_info *dpyinfo, } if (x_dnd_last_protocol_version != -1 && target != None) - x_dnd_send_position (x_dnd_frame, target, - x_dnd_last_protocol_version, - xev->root_x, xev->root_y, - x_dnd_selection_timestamp, - x_dnd_wanted_action); + { + dnd_state = xev->mods.effective; + + if (xev->buttons.mask_len) + { + if (XIMaskIsSet (xev->buttons.mask, 1)) + dnd_state |= Button1Mask; + if (XIMaskIsSet (xev->buttons.mask, 2)) + dnd_state |= Button2Mask; + if (XIMaskIsSet (xev->buttons.mask, 3)) + dnd_state |= Button3Mask; + } + + x_dnd_send_position (x_dnd_frame, target, + x_dnd_last_protocol_version, + xev->root_x, xev->root_y, + x_dnd_selection_timestamp, + x_dnd_wanted_action, 0, + dnd_state); + } else if (XM_DRAG_STYLE_IS_DYNAMIC (x_dnd_last_motif_style) && target != None) { if (!x_dnd_motif_setup_p) @@ -16858,116 +17563,146 @@ handle_one_xevent (struct x_display_info *dpyinfo, /* A fake XButtonEvent for x_construct_mouse_click. */ XButtonEvent bv; bool dnd_grab = false; + int dnd_state; if (x_dnd_in_progress && dpyinfo == FRAME_DISPLAY_INFO (x_dnd_frame)) { - for (int i = 0; i < xev->buttons.mask_len * 8; ++i) + if (xev->evtype == XI_ButtonPress + && x_dnd_last_seen_window != None + && x_dnd_last_protocol_version != -1) { - if (i != xev->detail && XIMaskIsSet (xev->buttons.mask, i)) - dnd_grab = true; + dnd_state = xev->mods.effective; + + if (xev->buttons.mask_len) + { + if (XIMaskIsSet (xev->buttons.mask, 1)) + dnd_state |= Button1Mask; + if (XIMaskIsSet (xev->buttons.mask, 2)) + dnd_state |= Button2Mask; + if (XIMaskIsSet (xev->buttons.mask, 3)) + dnd_state |= Button3Mask; + } + + x_dnd_send_position (x_dnd_frame, x_dnd_last_seen_window, + x_dnd_last_protocol_version, xev->root_x, + xev->root_y, x_dnd_selection_timestamp, + x_dnd_wanted_action, xev->detail, dnd_state); + + goto XI_OTHER; } - if (!dnd_grab - && xev->evtype == XI_ButtonRelease) + if (xev->evtype == XI_ButtonRelease) { - x_dnd_end_window = x_dnd_last_seen_window; - x_dnd_in_progress = false; - - if (x_dnd_last_seen_window != None - && x_dnd_last_protocol_version != -1) + for (int i = 0; i < xev->buttons.mask_len * 8; ++i) { - x_dnd_pending_finish_target = x_dnd_last_seen_window; - x_dnd_waiting_for_finish_proto = x_dnd_last_protocol_version; - - x_dnd_waiting_for_finish - = x_dnd_send_drop (x_dnd_frame, x_dnd_last_seen_window, - x_dnd_selection_timestamp, - x_dnd_last_protocol_version); + if (i != xev->detail && XIMaskIsSet (xev->buttons.mask, i)) + dnd_grab = true; } - else if (x_dnd_last_seen_window != None) + + if (!dnd_grab) { - xm_drop_start_message dmsg; - xm_drag_receiver_info drag_receiver_info; - - if (!xm_read_drag_receiver_info (dpyinfo, x_dnd_last_seen_window, - &drag_receiver_info) - && drag_receiver_info.protocol_style != XM_DRAG_STYLE_NONE - && (x_dnd_allow_current_frame - || x_dnd_last_seen_window != FRAME_OUTER_WINDOW (x_dnd_frame))) - { - if (!x_dnd_motif_setup_p) - xm_setup_drag_info (dpyinfo, x_dnd_frame); + x_dnd_end_window = x_dnd_last_seen_window; + x_dnd_in_progress = false; - if (x_dnd_motif_setup_p) + if (x_dnd_last_seen_window != None + && x_dnd_last_protocol_version != -1) + { + x_dnd_pending_finish_target = x_dnd_last_seen_window; + x_dnd_waiting_for_finish_proto = x_dnd_last_protocol_version; + + x_dnd_waiting_for_finish + = x_dnd_send_drop (x_dnd_frame, x_dnd_last_seen_window, + x_dnd_selection_timestamp, + x_dnd_last_protocol_version); + x_dnd_finish_display = dpyinfo->display; + } + else if (x_dnd_last_seen_window != None) + { + xm_drop_start_message dmsg; + xm_drag_receiver_info drag_receiver_info; + + if (!xm_read_drag_receiver_info (dpyinfo, x_dnd_last_seen_window, + &drag_receiver_info) + && drag_receiver_info.protocol_style != XM_DRAG_STYLE_NONE + && (x_dnd_allow_current_frame + || x_dnd_last_seen_window != FRAME_OUTER_WINDOW (x_dnd_frame))) + { + if (!x_dnd_motif_setup_p) + xm_setup_drag_info (dpyinfo, x_dnd_frame); + + if (x_dnd_motif_setup_p) + { + memset (&dmsg, 0, sizeof dmsg); + + dmsg.reason = XM_DRAG_REASON (XM_DRAG_ORIGINATOR_INITIATOR, + XM_DRAG_REASON_DROP_START); + dmsg.byte_order = XM_BYTE_ORDER_CUR_FIRST; + dmsg.side_effects + = XM_DRAG_SIDE_EFFECT (xm_side_effect_from_action (dpyinfo, + x_dnd_wanted_action), + XM_DROP_SITE_VALID, + xm_side_effect_from_action (dpyinfo, + x_dnd_wanted_action), + (!x_dnd_xm_use_help + ? XM_DROP_ACTION_DROP + : XM_DROP_ACTION_DROP_HELP)); + dmsg.timestamp = xev->time; + dmsg.x = lrint (xev->root_x); + dmsg.y = lrint (xev->root_y); + /* This atom technically has to be + unique to each drag-and-drop + operation, but that isn't easy to + accomplish, since we cannot + randomly move data around between + selections. Let's hope no two + instances of Emacs try to drag + into the same window at the same + time. */ + dmsg.index_atom = dpyinfo->Xatom_XdndSelection; + dmsg.source_window = FRAME_X_WINDOW (x_dnd_frame); + + if (!XM_DRAG_STYLE_IS_DROP_ONLY (drag_receiver_info.protocol_style)) + x_dnd_send_xm_leave_for_drop (FRAME_DISPLAY_INFO (x_dnd_frame), + x_dnd_frame, x_dnd_last_seen_window, + xev->time); + + xm_send_drop_message (dpyinfo, FRAME_X_WINDOW (x_dnd_frame), + x_dnd_last_seen_window, &dmsg); + + x_dnd_waiting_for_finish = true; + x_dnd_waiting_for_motif_finish_display = dpyinfo; + x_dnd_waiting_for_motif_finish = 1; + x_dnd_finish_display = dpyinfo->display; + } + } + else { - memset (&dmsg, 0, sizeof dmsg); - - dmsg.reason = XM_DRAG_REASON (XM_DRAG_ORIGINATOR_INITIATOR, - XM_DRAG_REASON_DROP_START); - dmsg.byte_order = XM_BYTE_ORDER_CUR_FIRST; - dmsg.side_effects - = XM_DRAG_SIDE_EFFECT (xm_side_effect_from_action (dpyinfo, - x_dnd_wanted_action), - XM_DROP_SITE_VALID, - xm_side_effect_from_action (dpyinfo, - x_dnd_wanted_action), - (!x_dnd_xm_use_help - ? XM_DROP_ACTION_DROP - : XM_DROP_ACTION_DROP_HELP)); - dmsg.timestamp = xev->time; - dmsg.x = lrint (xev->root_x); - dmsg.y = lrint (xev->root_y); - /* This atom technically has to be - unique to each drag-and-drop - operation, but that isn't easy to - accomplish, since we cannot - randomly move data around between - selections. Let's hope no two - instances of Emacs try to drag - into the same window at the same - time. */ - dmsg.index_atom = dpyinfo->Xatom_XdndSelection; - dmsg.source_window = FRAME_X_WINDOW (x_dnd_frame); - - if (!XM_DRAG_STYLE_IS_DROP_ONLY (drag_receiver_info.protocol_style)) - x_dnd_send_xm_leave_for_drop (FRAME_DISPLAY_INFO (x_dnd_frame), - x_dnd_frame, x_dnd_last_seen_window, - xev->time); - - xm_send_drop_message (dpyinfo, FRAME_X_WINDOW (x_dnd_frame), - x_dnd_last_seen_window, &dmsg); - - x_dnd_waiting_for_finish = true; - x_dnd_waiting_for_motif_finish = 1; + x_set_pending_dnd_time (xev->time); + x_dnd_send_unsupported_drop (dpyinfo, (x_dnd_last_seen_toplevel != None + ? x_dnd_last_seen_toplevel + : x_dnd_last_seen_window), + xev->root_x, xev->root_y, xev->time); } } - else + else if (x_dnd_last_seen_toplevel != None) { x_set_pending_dnd_time (xev->time); - x_dnd_send_unsupported_drop (dpyinfo, (x_dnd_last_seen_toplevel != None - ? x_dnd_last_seen_toplevel - : x_dnd_last_seen_window), - xev->root_x, xev->root_y, xev->time); + x_dnd_send_unsupported_drop (dpyinfo, + x_dnd_last_seen_toplevel, + xev->root_x, xev->root_y, + xev->time); } - } - else if (x_dnd_last_seen_toplevel != None) - { - x_set_pending_dnd_time (xev->time); - x_dnd_send_unsupported_drop (dpyinfo, - x_dnd_last_seen_toplevel, - xev->root_x, xev->root_y, - xev->time); - } - x_dnd_last_protocol_version = -1; - x_dnd_last_motif_style = XM_DRAG_STYLE_NONE; - x_dnd_last_seen_window = None; - x_dnd_last_seen_toplevel = None; - x_dnd_frame = NULL; - x_set_dnd_targets (NULL, 0); + x_dnd_last_protocol_version = -1; + x_dnd_last_motif_style = XM_DRAG_STYLE_NONE; + x_dnd_last_seen_window = None; + x_dnd_last_seen_toplevel = None; + x_dnd_frame = NULL; + x_set_dnd_targets (NULL, 0); - goto XI_OTHER; + goto XI_OTHER; + } } } @@ -17283,13 +18018,15 @@ handle_one_xevent (struct x_display_info *dpyinfo, #ifndef USE_TOOLKIT_SCROLL_BARS if (bar) - x_scroll_bar_handle_click (bar, (XEvent *) &bv, &inev.ie); + x_scroll_bar_handle_click (bar, (XEvent *) &bv, &inev.ie, + source ? source->name : Qnil); #else /* Make the "Ctrl-Mouse-2 splits window" work for toolkit scroll bars. */ if (bar && xev->mods.effective & ControlMask) { - x_scroll_bar_handle_click (bar, (XEvent *) &bv, &inev.ie); + x_scroll_bar_handle_click (bar, (XEvent *) &bv, &inev.ie, + source ? source->name : Qnil); *finish = X_EVENT_DROP; } #endif @@ -17355,6 +18092,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, char *copy_bufptr = copy_buffer; int copy_bufsiz = sizeof (copy_buffer); ptrdiff_t i; + uint old_state; struct xi_device_t *device, *source; coding = Qlatin_1; @@ -17368,7 +18106,41 @@ handle_one_xevent (struct x_display_info *dpyinfo, #if defined (USE_X_TOOLKIT) || defined (USE_GTK) /* Dispatch XI_KeyPress events when in menu. */ if (popup_activated ()) - goto XI_OTHER; + { +#ifdef USE_LUCID + /* This makes key navigation work inside menus. */ + use_copy = true; + 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.state = ((xev->mods.effective & ~(1 << 13 | 1 << 14)) + | (xev->group.effective << 13)); + + 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); + + if (xev->buttons.mask_len) + { + if (XIMaskIsSet (xev->buttons.mask, 1)) + copy.xkey.state |= Button1Mask; + if (XIMaskIsSet (xev->buttons.mask, 2)) + copy.xkey.state |= Button2Mask; + if (XIMaskIsSet (xev->buttons.mask, 3)) + copy.xkey.state |= Button3Mask; + } + + copy.xkey.keycode = xev->detail; + copy.xkey.same_screen = True; +#endif + goto XI_OTHER; + } #endif x_display_set_last_user_time (dpyinfo, xev->time); @@ -17599,9 +18371,18 @@ handle_one_xevent (struct x_display_info *dpyinfo, else #endif { + old_state = xkey.state; + xkey.state &= ~ControlMask; + xkey.state &= ~(dpyinfo->meta_mod_mask + | dpyinfo->super_mod_mask + | dpyinfo->hyper_mod_mask + | dpyinfo->alt_mod_mask); + nbytes = XLookupString (&xkey, copy_bufptr, copy_bufsiz, &keysym, NULL); + + xkey.state = old_state; } } @@ -17806,7 +18587,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, #endif case XI_KeyRelease: -#if defined HAVE_X_I18N || defined USE_GTK +#if defined HAVE_X_I18N || defined USE_GTK || defined USE_LUCID { XKeyPressedEvent xkey; @@ -17842,14 +18623,31 @@ handle_one_xevent (struct x_display_info *dpyinfo, xkey.keycode = xev->detail; xkey.same_screen = True; +#ifdef USE_LUCID + if (!popup_activated ()) + { +#endif #ifdef HAVE_X_I18N - if (x_filter_event (dpyinfo, (XEvent *) &xkey)) - *finish = X_EVENT_DROP; -#else - f = x_any_window_to_frame (xkey->event); + if (x_filter_event (dpyinfo, (XEvent *) &xkey)) + *finish = X_EVENT_DROP; +#elif defined USE_GTK + f = x_any_window_to_frame (xkey->event); - if (f && xg_filter_key (f, event)) - *finish = X_EVENT_DROP; + if (f && xg_filter_key (f, event)) + *finish = X_EVENT_DROP; +#endif +#ifdef USE_LUCID + } + else + { + /* FIXME: the Lucid menu bar pops down upon any key + release event, so we don't dispatch these events + at all, which doesn't seem to be the right + solution. + + use_copy = true; + copy.xkey = xkey; */ + } #endif } #endif @@ -17876,6 +18674,48 @@ handle_one_xevent (struct x_display_info *dpyinfo, { if (hev->info[i].flags & XIDeviceEnabled) { + /* Handle all disabled devices now, to prevent + things happening out-of-order later. */ + if (n_disabled) + { + ndevices = 0; + devices = xmalloc (sizeof *devices * dpyinfo->num_devices); + + for (i = 0; i < dpyinfo->num_devices; ++i) + { + for (j = 0; j < n_disabled; ++j) + { + if (disabled[j] == dpyinfo->devices[i].device_id) + { +#ifdef HAVE_XINPUT2_1 + xfree (dpyinfo->devices[i].valuators); +#endif +#ifdef HAVE_XINPUT2_2 + tem = dpyinfo->devices[i].touchpoints; + while (tem) + { + last = tem; + tem = tem->next; + xfree (last); + } +#endif + goto continue_detachment; + } + } + + devices[ndevices++] = dpyinfo->devices[i]; + + continue_detachment: + continue; + } + + xfree (dpyinfo->devices); + dpyinfo->devices = devices; + dpyinfo->num_devices = ndevices; + + n_disabled = 0; + } + x_catch_errors (dpyinfo->display); info = XIQueryDevice (dpyinfo->display, hev->info[i].deviceid, &ndevices); @@ -17907,8 +18747,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, if (info) { if (device && info->enabled) - device->master_p = (info->use == XIMasterKeyboard - || info->use == XIMasterPointer); + device->use = info->use; else if (device) disabled[n_disabled++] = hev->info[i].deviceid; @@ -17940,13 +18779,13 @@ handle_one_xevent (struct x_display_info *dpyinfo, xfree (last); } #endif - goto continue_detachment; + goto break_detachment; } } devices[ndevices++] = dpyinfo->devices[i]; - continue_detachment: + break_detachment: continue; } @@ -18393,6 +19232,10 @@ handle_one_xevent (struct x_display_info *dpyinfo, XkbRefreshKeyboardMapping (&xkbevent->map); x_find_modifier_meanings (dpyinfo); } + else if (x_dnd_in_progress + && xkbevent->any.xkb_type == XkbStateNotify) + x_dnd_keyboard_state = (xkbevent->state.mods + | xkbevent->state.ptr_buttons); } #endif #ifdef HAVE_XSHAPE @@ -18401,7 +19244,9 @@ handle_one_xevent (struct x_display_info *dpyinfo, && x_dnd_in_progress && x_dnd_use_toplevels && dpyinfo == FRAME_DISPLAY_INFO (x_dnd_frame)) { +#ifndef USE_GTK XEvent xevent; +#endif XShapeEvent *xse = (XShapeEvent *) event; #if defined HAVE_XCB_SHAPE && defined HAVE_XCB_SHAPE_INPUT_RECTS xcb_shape_get_rectangles_cookie_t bounding_rect_cookie; @@ -18418,6 +19263,10 @@ handle_one_xevent (struct x_display_info *dpyinfo, int rc, ordering; #endif + /* Somehow this really interferes with GTK's own processing + of ShapeNotify events. Not sure what GTK uses them for, + but we cannot skip any of them here. */ +#ifndef USE_GTK while (XPending (dpyinfo->display)) { XNextEvent (dpyinfo->display, &xevent); @@ -18431,6 +19280,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, break; } } +#endif for (struct x_client_list_window *tem = x_dnd_toplevels; tem; tem = tem->next) @@ -18612,12 +19462,12 @@ handle_one_xevent (struct x_display_info *dpyinfo, { /* Ignore some obviously bogus ConfigureNotify events that other clients have been known to send Emacs. - (bug#54051)*/ + (bug#54051) */ if (event->type != ConfigureNotify || (event->xconfigure.width != 0 && event->xconfigure.height != 0)) { -#if defined USE_MOTIF && defined HAVE_XINPUT2 +#if defined USE_X_TOOLKIT && defined HAVE_XINPUT2 XtDispatchEvent (use_copy ? © : (XEvent *) event); #else XtDispatchEvent ((XEvent *) event); @@ -18646,6 +19496,12 @@ handle_one_xevent (struct x_display_info *dpyinfo, count++; } +#ifdef USE_TOOLKIT_SCROLL_BARS + if (event->xany.type == ClientMessage + && inev.ie.kind == SCROLL_BAR_CLICK_EVENT) + x_unprotect_window_for_callback (dpyinfo); +#endif + if (do_help && !(hold_quit && hold_quit->kind != NO_EVENT)) { @@ -18674,11 +19530,13 @@ handle_one_xevent (struct x_display_info *dpyinfo, redisplay. To ensure that these changes become visible, draw them here. */ +#ifdef HAVE_XDBE if (f) flush_dirty_back_buffer_on (f); if (any && any != f) flush_dirty_back_buffer_on (any); +#endif return count; } @@ -18721,6 +19579,13 @@ XTread_socket (struct terminal *terminal, struct input_event *hold_quit) bool event_found = false; struct x_display_info *dpyinfo = terminal->display_info.x; + /* Don't allow XTread_socket to do anything if drag-and-drop is in + progress. If unblock_input causes XTread_socket to be called and + read X events while the drag-and-drop event loop is in progress, + things can go wrong very quick. */ + if (x_dnd_in_progress || x_dnd_waiting_for_finish) + return 0; + block_input (); /* For debugging, this gives a way to fake an I/O error. */ @@ -18974,6 +19839,9 @@ x_draw_bar_cursor (struct window *w, struct glyph_row *row, int width, enum text else xgcv.background = xgcv.foreground = f->output_data.x->cursor_pixel; xgcv.graphics_exposures = False; + xgcv.line_width = 1; + + mask |= GCLineWidth; if (gc) XChangeGC (dpy, gc, mask, &xgcv); @@ -19426,16 +20294,90 @@ static char *error_msg; static AVOID x_connection_closed (Display *dpy, const char *error_message, bool ioerror) { - struct x_display_info *dpyinfo = x_display_info_for_display (dpy); + struct x_display_info *dpyinfo; Lisp_Object frame, tail; specpdl_ref idx = SPECPDL_INDEX (); + void *io_error_handler; + xm_drop_start_message dmsg; + struct frame *f; + dpyinfo = x_display_info_for_display (dpy); error_msg = alloca (strlen (error_message) + 1); strcpy (error_msg, error_message); /* Inhibit redisplay while frames are being deleted. */ specbind (Qinhibit_redisplay, Qt); + /* If drag-and-drop is in progress, cancel drag-and-drop. If DND + frame's display is DPY, don't reset event masks or try to send + responses to other programs because the display is going + away. */ + + if (x_dnd_in_progress || x_dnd_waiting_for_finish) + { + /* Handle display disconnect errors here because this function + is not reentrant at this particular spot. */ + io_error_handler = XSetIOErrorHandler (x_dnd_io_error_handler); + + if (!sigsetjmp (x_dnd_disconnect_handler, 1) + && x_dnd_in_progress + && dpy != (x_dnd_waiting_for_finish + ? x_dnd_finish_display + : FRAME_X_DISPLAY (x_dnd_frame))) + { + /* Clean up drag and drop if the drag frame's display isn't + the one being disconnected. */ + f = x_dnd_frame; + + if (x_dnd_last_seen_window != None + && x_dnd_last_protocol_version != -1) + x_dnd_send_leave (x_dnd_frame, + x_dnd_last_seen_window); + else if (x_dnd_last_seen_window != None + && !XM_DRAG_STYLE_IS_DROP_ONLY (x_dnd_last_motif_style) + && x_dnd_last_motif_style != XM_DRAG_STYLE_NONE + && x_dnd_motif_setup_p) + { + dmsg.reason = XM_DRAG_REASON (XM_DRAG_ORIGINATOR_INITIATOR, + XM_DRAG_REASON_DROP_START); + dmsg.byte_order = XM_BYTE_ORDER_CUR_FIRST; + dmsg.timestamp = FRAME_DISPLAY_INFO (f)->last_user_time; + dmsg.side_effects + = XM_DRAG_SIDE_EFFECT (xm_side_effect_from_action (FRAME_DISPLAY_INFO (f), + x_dnd_wanted_action), + XM_DROP_SITE_VALID, + xm_side_effect_from_action (FRAME_DISPLAY_INFO (f), + x_dnd_wanted_action), + XM_DROP_ACTION_DROP_CANCEL); + dmsg.x = 0; + dmsg.y = 0; + dmsg.index_atom = FRAME_DISPLAY_INFO (f)->Xatom_XdndSelection; + dmsg.source_window = FRAME_X_WINDOW (f); + + x_dnd_send_xm_leave_for_drop (FRAME_DISPLAY_INFO (f), f, + x_dnd_last_seen_window, 0); + xm_send_drop_message (FRAME_DISPLAY_INFO (f), FRAME_X_WINDOW (f), + x_dnd_last_seen_window, &dmsg); + } + } + + XSetIOErrorHandler (io_error_handler); + dpyinfo = x_display_info_for_display (dpy); + + x_dnd_last_seen_window = None; + x_dnd_last_seen_toplevel = None; + x_dnd_in_progress = false; + x_set_dnd_targets (NULL, 0); + x_dnd_waiting_for_finish = false; + + if (x_dnd_use_toplevels) + x_dnd_free_toplevels (); + + x_dnd_return_frame_object = NULL; + x_dnd_movement_frame = NULL; + x_dnd_frame = NULL; + } + if (dpyinfo) { /* Protect display from being closed when we delete the last @@ -19513,7 +20455,7 @@ For details, see etc/PROBLEMS.\n", if (terminal_list == 0) { fprintf (stderr, "%s\n", error_msg); - Fkill_emacs (make_fixnum (70)); + Fkill_emacs (make_fixnum (70), Qnil); } totally_unblock_input (); @@ -19612,6 +20554,7 @@ x_io_error_quitter (Display *display) DisplayString (display)); x_connection_closed (display, buf, true); } + /* Changing the font of the frame. */ @@ -20158,19 +21101,26 @@ x_wm_supports (struct frame *f, Atom want_atom) static void set_wm_state (Lisp_Object frame, bool add, Atom atom, Atom value) { - struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (XFRAME (frame)); + struct x_display_info *dpyinfo; + XEvent msg; + + dpyinfo = FRAME_DISPLAY_INFO (XFRAME (frame)); + msg.xclient.type = ClientMessage; + msg.xclient.window = FRAME_OUTER_WINDOW (XFRAME (frame)); + msg.xclient.message_type = dpyinfo->Xatom_net_wm_state; + msg.xclient.format = 32; - x_send_client_event (frame, make_fixnum (0), frame, - dpyinfo->Xatom_net_wm_state, - make_fixnum (32), - /* 1 = add, 0 = remove */ - Fcons - (make_fixnum (add), - Fcons - (INT_TO_INTEGER (atom), - (value != 0 - ? list1 (INT_TO_INTEGER (value)) - : Qnil)))); + msg.xclient.data.l[0] = add ? 1 : 0; + msg.xclient.data.l[1] = atom; + msg.xclient.data.l[2] = value; + msg.xclient.data.l[3] = 1; /* Source indication. */ + msg.xclient.data.l[4] = 0; + + block_input (); + XSendEvent (dpyinfo->display, dpyinfo->root_window, + False, (SubstructureRedirectMask + | SubstructureNotifyMask), &msg); + unblock_input (); } void @@ -20971,20 +21921,32 @@ xembed_request_focus (struct frame *f) static void x_ewmh_activate_frame (struct frame *f) { - /* See Window Manager Specification/Extended Window Manager Hints at - https://freedesktop.org/wiki/Specifications/wm-spec/ */ + XEvent msg; + struct x_display_info *dpyinfo; - struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); + dpyinfo = FRAME_DISPLAY_INFO (f); - if (FRAME_VISIBLE_P (f) && x_wm_supports (f, dpyinfo->Xatom_net_active_window)) + if (FRAME_VISIBLE_P (f) + && x_wm_supports (f, dpyinfo->Xatom_net_active_window)) { - Lisp_Object frame; - XSETFRAME (frame, f); - x_send_client_event (frame, make_fixnum (0), frame, - dpyinfo->Xatom_net_active_window, - make_fixnum (32), - list2 (make_fixnum (1), - INT_TO_INTEGER (dpyinfo->last_user_time))); + /* See the documentation at + https://specifications.freedesktop.org/wm-spec/wm-spec-latest.html + for more details on the format of this message. */ + msg.xclient.type = ClientMessage; + msg.xclient.window = FRAME_OUTER_WINDOW (f); + msg.xclient.message_type = dpyinfo->Xatom_net_active_window; + msg.xclient.format = 32; + msg.xclient.data.l[0] = 1; + msg.xclient.data.l[1] = dpyinfo->last_user_time; + msg.xclient.data.l[2] = (!dpyinfo->x_focus_frame + ? None + : FRAME_OUTER_WINDOW (dpyinfo->x_focus_frame)); + msg.xclient.data.l[3] = 0; + msg.xclient.data.l[4] = 0; + + XSendEvent (dpyinfo->display, dpyinfo->root_window, + False, (SubstructureRedirectMask + | SubstructureNotifyMask), &msg); } } @@ -21217,6 +22179,12 @@ x_make_frame_visible (struct frame *f) XMapRaised (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f)); #endif /* not USE_GTK */ #endif /* not USE_X_TOOLKIT */ + + if (FRAME_X_EMBEDDED_P (f)) + { + SET_FRAME_VISIBLE (f, true); + SET_FRAME_ICONIFIED (f, false); + } } XFlush (FRAME_X_DISPLAY (f)); @@ -21517,7 +22485,7 @@ x_free_frame_resources (struct frame *f) /* Always exit with visible pointer to avoid weird issue with Xfixes (Bug#17609). */ if (f->pointer_invisible) - FRAME_DISPLAY_INFO (f)->toggle_visible_pointer (f, 0); + XTtoggle_invisible_pointer (f, 0); /* We must free faces before destroying windows because some font-driver (e.g. xft) access a window while finishing a @@ -21543,9 +22511,6 @@ x_free_frame_resources (struct frame *f) #ifdef HAVE_X_I18N if (FRAME_XIC (f)) free_frame_xic (f); - - if (f->output_data.x->preedit_chars) - xfree (f->output_data.x->preedit_chars); #endif #ifdef USE_CAIRO @@ -21698,6 +22663,17 @@ x_destroy_window (struct frame *f) xfree (f->output_data.x->saved_menu_event); xfree (f->output_data.x); + +#ifdef HAVE_X_I18N + if (f->output_data.x->preedit_chars) + xfree (f->output_data.x->preedit_chars); +#endif + +#ifdef HAVE_XINPUT2 + if (f->output_data.x->xi_masks) + XFree (f->output_data.x->xi_masks); +#endif + f->output_data.x = NULL; dpyinfo->reference_count--; @@ -21713,10 +22689,10 @@ x_destroy_window (struct frame *f) flag (this is useful when FLAGS is 0). The GTK version is in gtkutils.c. */ -#ifndef USE_GTK void x_wm_set_size_hint (struct frame *f, long flags, bool user_position) { +#ifndef USE_GTK XSizeHints size_hints; Window window = FRAME_OUTER_WINDOW (f); #ifdef USE_X_TOOLKIT @@ -21873,8 +22849,10 @@ x_wm_set_size_hint (struct frame *f, long flags, bool user_position) #endif /* PWinGravity */ XSetWMNormalHints (FRAME_X_DISPLAY (f), window, &size_hints); +#else + xg_wm_set_size_hint (f, flags, user_position); +#endif /* USE_GTK */ } -#endif /* not USE_GTK */ /* Used for IconicState or NormalState */ @@ -22127,100 +23105,6 @@ my_log_handler (const gchar *log_domain, GLogLevelFlags log_level, } #endif -/* Create invisible cursor on X display referred by DPYINFO. */ - -static Cursor -make_invisible_cursor (struct x_display_info *dpyinfo) -{ - Display *dpy = dpyinfo->display; - static char const no_data[] = { 0 }; - Pixmap pix; - XColor col; - Cursor c = 0; - - x_catch_errors (dpy); - pix = XCreateBitmapFromData (dpy, dpyinfo->root_window, no_data, 1, 1); - if (! x_had_errors_p (dpy) && pix != None) - { - Cursor pixc; - col.pixel = 0; - col.red = col.green = col.blue = 0; - col.flags = DoRed | DoGreen | DoBlue; - pixc = XCreatePixmapCursor (dpy, pix, pix, &col, &col, 0, 0); - if (! x_had_errors_p (dpy) && pixc != None) - c = pixc; - XFreePixmap (dpy, pix); - } - - x_uncatch_errors (); - - return c; -} - -/* True if DPY supports Xfixes extension >= 4. */ - -static bool -x_probe_xfixes_extension (Display *dpy) -{ -#ifdef HAVE_XFIXES - struct x_display_info *info - = x_display_info_for_display (dpy); - - return (info - && info->xfixes_supported_p - && info->xfixes_major >= 4); -#else - return false; -#endif /* HAVE_XFIXES */ -} - -/* Toggle mouse pointer visibility on frame F by using Xfixes functions. */ - -static void -xfixes_toggle_visible_pointer (struct frame *f, bool invisible) -{ -#ifdef HAVE_XFIXES - if (invisible) - XFixesHideCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f)); - else - XFixesShowCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f)); - f->pointer_invisible = invisible; -#else - emacs_abort (); -#endif /* HAVE_XFIXES */ -} - -/* Toggle mouse pointer visibility on frame F by using invisible cursor. */ - -static void -x_toggle_visible_pointer (struct frame *f, bool invisible) -{ - eassert (FRAME_DISPLAY_INFO (f)->invisible_cursor != 0); - if (invisible) - XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), - FRAME_DISPLAY_INFO (f)->invisible_cursor); - else - XDefineCursor (FRAME_X_DISPLAY (f), FRAME_X_WINDOW (f), - f->output_data.x->current_cursor); - f->pointer_invisible = invisible; -} - -/* Setup pointer blanking, prefer Xfixes if available. */ - -static void -x_setup_pointer_blanking (struct x_display_info *dpyinfo) -{ - /* FIXME: the brave tester should set EMACS_XFIXES because we're suspecting - X server bug, see https://debbugs.gnu.org/cgi/bugreport.cgi?bug=17609. */ - if (egetenv ("EMACS_XFIXES") && x_probe_xfixes_extension (dpyinfo->display)) - dpyinfo->toggle_visible_pointer = xfixes_toggle_visible_pointer; - else - { - dpyinfo->toggle_visible_pointer = x_toggle_visible_pointer; - dpyinfo->invisible_cursor = make_invisible_cursor (dpyinfo); - } -} - /* Current X display connection identifier. Incremented for each next connection established. */ static unsigned x_display_id; @@ -22432,7 +23316,7 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) vendor ? build_string (vendor) : empty_unibyte_string)); block_input (); terminal->next_terminal = terminal_list; - terminal_list = terminal; + terminal_list = terminal; } /* Don't let the initial kboard remain current longer than necessary. @@ -22459,6 +23343,10 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) dpyinfo->smallest_font_height = 1; dpyinfo->smallest_char_width = 1; + dpyinfo->color_names_size = 256; + dpyinfo->color_names = xzalloc (dpyinfo->color_names_size + * sizeof *dpyinfo->color_names); + /* Set the name of the terminal. */ terminal->name = xlispstrdup (display_name); @@ -22592,9 +23480,9 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) SynchronizeResize, Qnil, Qnil); - if (STRINGP (value) && - (!strcmp (SSDATA (value), "false") - || !strcmp (SSDATA (value), "off"))) + if (STRINGP (value) + && (!strcmp (SSDATA (value), "false") + || !strcmp (SSDATA (value), "off"))) dpyinfo->xsync_supported_p = false; } #endif @@ -22719,6 +23607,23 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) int major = 2; int xi_first_event, xi_first_error; +#ifndef HAVE_GTK3 + { + AUTO_STRING (disableInputExtension, "disableInputExtension"); + AUTO_STRING (DisableInputExtension, "DisableInputExtension"); + + Lisp_Object value = gui_display_get_resource (dpyinfo, + disableInputExtension, + DisableInputExtension, + Qnil, Qnil); + + if (STRINGP (value) + && (!strcmp (SSDATA (value), "on") + || !strcmp (SSDATA (value), "true"))) + goto skip_xi_setup; + } +#endif + #ifdef HAVE_XINPUT2_4 int minor = 4; #elif defined HAVE_XINPUT2_3 /* XInput 2.3 */ @@ -22814,6 +23719,10 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) } dpyinfo->xi2_version = minor; +#ifndef HAVE_GTK3 + skip_xi_setup: +#endif + ; #endif #ifdef HAVE_XRANDR @@ -22849,8 +23758,7 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) XkbGroupNamesMask | XkbVirtualModNamesMask, dpyinfo->xkb_desc); - XkbSelectEvents (dpyinfo->display, - XkbUseCoreKbd, + XkbSelectEvents (dpyinfo->display, XkbUseCoreKbd, XkbNewKeyboardNotifyMask | XkbMapNotifyMask, XkbNewKeyboardNotifyMask | XkbMapNotifyMask); } @@ -22949,7 +23857,6 @@ 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) ATOM_REFS_INIT ("_MOTIF_WM_HINTS", Xatom_MOTIF_WM_HINTS) /* For properties of font. */ @@ -23083,7 +23990,10 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) gray_bits, gray_width, gray_height, 1, 0, 1); - x_setup_pointer_blanking (dpyinfo); + dpyinfo->invisible_cursor = make_invisible_cursor (dpyinfo); +#ifdef HAVE_XFIXES + dpyinfo->fixes_pointer_blanking = egetenv ("EMACS_XFIXES"); +#endif #ifdef HAVE_X_I18N xim_initialize (dpyinfo, resource_name); @@ -23195,6 +24105,12 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) x_extension_initialize (dpyinfo); #endif +#ifdef USE_TOOLKIT_SCROLL_BARS + dpyinfo->protected_windows = xmalloc (sizeof (Lisp_Object) * 256); + dpyinfo->n_protected_windows = 0; + dpyinfo->protected_windows_max = 256; +#endif + unblock_input (); return dpyinfo; @@ -23208,6 +24124,7 @@ x_delete_display (struct x_display_info *dpyinfo) { struct terminal *t; struct color_name_cache_entry *color_entry, *next_color_entry; + int i; /* Close all frames and delete the generic struct terminal for this X display. */ @@ -23226,6 +24143,9 @@ x_delete_display (struct x_display_info *dpyinfo) if (next_noop_dpyinfo == dpyinfo) next_noop_dpyinfo = dpyinfo->next; + if (mouse_click_timeout_display == dpyinfo) + mouse_click_timeout_display = NULL; + if (x_display_list == dpyinfo) x_display_list = dpyinfo->next; else @@ -23237,24 +24157,30 @@ x_delete_display (struct x_display_info *dpyinfo) tail->next = tail->next->next; } - for (color_entry = dpyinfo->color_names; - color_entry; - color_entry = next_color_entry) + for (i = 0; i < dpyinfo->color_names_size; ++i) { - next_color_entry = color_entry->next; - xfree (color_entry->name); - xfree (color_entry); + for (color_entry = dpyinfo->color_names[i]; + color_entry; color_entry = next_color_entry) + { + next_color_entry = color_entry->next; + + xfree (color_entry->name); + xfree (color_entry); + } } + xfree (dpyinfo->color_names); xfree (dpyinfo->x_id_name); xfree (dpyinfo->x_dnd_atoms); xfree (dpyinfo->color_cells); - xfree (dpyinfo); - +#ifdef USE_TOOLKIT_SCROLL_BARS + xfree (dpyinfo->protected_windows); +#endif #ifdef HAVE_XINPUT2 if (dpyinfo->supports_xi2) x_free_xi_devices (dpyinfo); #endif + xfree (dpyinfo); } #ifdef USE_X_TOOLKIT @@ -23370,6 +24296,27 @@ x_delete_terminal (struct terminal *terminal) image_destroy_all_bitmaps (dpyinfo); XSetCloseDownMode (dpyinfo->display, DestroyAll); + /* Get rid of any drag-and-drop operation that might be in + progress as well. */ + if ((x_dnd_in_progress || x_dnd_waiting_for_finish) + && dpyinfo->display == (x_dnd_waiting_for_finish + ? x_dnd_finish_display + : FRAME_X_DISPLAY (x_dnd_frame))) + { + x_dnd_last_seen_window = None; + x_dnd_last_seen_toplevel = None; + x_dnd_in_progress = false; + x_set_dnd_targets (NULL, 0); + x_dnd_waiting_for_finish = false; + + if (x_dnd_use_toplevels) + x_dnd_free_toplevels (); + + x_dnd_return_frame_object = NULL; + x_dnd_movement_frame = NULL; + x_dnd_frame = NULL; + } + /* Whether or not XCloseDisplay destroys the associated resource database depends on the version of libX11. To avoid both crash and memory leak, we dissociate the database from the @@ -23457,7 +24404,9 @@ x_create_terminal (struct x_display_info *dpyinfo) terminal->update_end_hook = x_update_end; terminal->read_socket_hook = XTread_socket; terminal->frame_up_to_date_hook = XTframe_up_to_date; +#ifdef HAVE_XDBE terminal->buffer_flipping_unblocked_hook = XTbuffer_flipping_unblocked_hook; +#endif terminal->defined_color_hook = x_defined_color; terminal->query_frame_background_color = x_query_frame_background_color; terminal->query_colors = x_query_colors; @@ -23511,6 +24460,7 @@ x_initialize (void) x_noop_count = 0; any_help_event_p = false; ignore_next_mouse_click_timeout = 0; + mouse_click_timeout_display = NULL; #ifdef USE_GTK current_count = -1; @@ -23580,7 +24530,7 @@ void mark_xterm (void) { Lisp_Object val; -#ifdef HAVE_XINPUT2 +#if defined HAVE_XINPUT2 || defined USE_TOOLKIT_SCROLL_BARS struct x_display_info *dpyinfo; int i; #endif @@ -23597,11 +24547,17 @@ mark_xterm (void) mark_object (val); } -#ifdef HAVE_XINPUT2 +#if defined HAVE_XINPUT2 || defined USE_TOOLKIT_SCROLL_BARS for (dpyinfo = x_display_list; dpyinfo; dpyinfo = dpyinfo->next) { +#ifdef HAVE_XINPUT2 for (i = 0; i < dpyinfo->num_devices; ++i) mark_object (dpyinfo->devices[i].name); +#endif +#ifdef USE_TOOLKIT_SCROLL_BARS + for (i = 0; i < dpyinfo->n_protected_windows; ++i) + mark_object (dpyinfo->protected_windows[i]); +#endif } #endif } diff --git a/src/xterm.h b/src/xterm.h index 69313166db9..74e6d1a96cb 100644 --- a/src/xterm.h +++ b/src/xterm.h @@ -232,8 +232,7 @@ struct xi_device_t #ifdef HAVE_XINPUT2_1 int scroll_valuator_count; #endif - int grab; - bool master_p; + int grab, use; #ifdef HAVE_XINPUT2_2 bool direct_p; #endif @@ -322,8 +321,10 @@ struct x_display_info Unused if this display supports Xfixes extension. */ Cursor invisible_cursor; - /* Function used to toggle pointer visibility on this display. */ - void (*toggle_visible_pointer) (struct frame *, bool); +#ifdef HAVE_XFIXES + /* Whether or not to use Xfixes for pointer blanking. */ + bool fixes_pointer_blanking; +#endif #ifdef USE_GTK /* The GDK cursor for scroll bars and popup menus. */ @@ -414,7 +415,7 @@ struct x_display_info Atom Xatom_CLIPBOARD, Xatom_TIMESTAMP, Xatom_TEXT, Xatom_DELETE, Xatom_COMPOUND_TEXT, Xatom_UTF8_STRING, Xatom_MULTIPLE, Xatom_INCR, Xatom_EMACS_TMP, Xatom_TARGETS, Xatom_NULL, - Xatom_ATOM, Xatom_ATOM_PAIR, Xatom_CLIPBOARD_MANAGER, Xatom_COUNTER, + Xatom_ATOM, Xatom_ATOM_PAIR, Xatom_CLIPBOARD_MANAGER, Xatom_EMACS_SERVER_TIME_PROP; /* More atoms for font properties. The last three are private @@ -510,7 +511,10 @@ struct x_display_info #endif /* A cache mapping color names to RGB values. */ - struct color_name_cache_entry *color_names; + struct color_name_cache_entry **color_names; + + /* The size of that hash table. */ + int color_names_size; /* If non-null, a cache of the colors in the color map. Don't use this directly, call x_color_cells instead. */ @@ -673,6 +677,12 @@ struct x_display_info int xshape_event_base; int xshape_error_base; #endif + +#ifdef USE_TOOLKIT_SCROLL_BARS + Lisp_Object *protected_windows; + int n_protected_windows; + int protected_windows_max; +#endif }; #ifdef HAVE_X_I18N @@ -977,6 +987,11 @@ struct x_output bool preedit_active; int preedit_caret; #endif + +#ifdef HAVE_XINPUT2 + XIEventMask *xi_masks; + int num_xi_masks; +#endif }; enum @@ -1010,13 +1025,15 @@ extern void x_mark_frame_dirty (struct frame *f); code after any drawing command, but we can run code whenever someone asks for the handle necessary to draw. */ #define FRAME_X_DRAWABLE(f) \ - (x_mark_frame_dirty((f)), FRAME_X_RAW_DRAWABLE ((f))) + (x_mark_frame_dirty ((f)), FRAME_X_RAW_DRAWABLE ((f))) +#ifdef HAVE_XDBE #define FRAME_X_DOUBLE_BUFFERED_P(f) \ (FRAME_X_WINDOW (f) != FRAME_X_RAW_DRAWABLE (f)) /* Return the need-buffer-flip flag for frame F. */ #define FRAME_X_NEED_BUFFER_FLIP(f) ((f)->output_data.x->need_buffer_flip) +#endif /* Return the outermost X window associated with the frame F. */ #ifdef USE_X_TOOLKIT @@ -1478,13 +1495,6 @@ extern void x_handle_selection_notify (const XSelectionEvent *); extern void x_handle_selection_event (struct selection_input_event *); extern void x_clear_frame_selections (struct frame *); -extern void x_send_client_event (Lisp_Object display, - Lisp_Object dest, - Lisp_Object from, - Atom message_type, - Lisp_Object format, - Lisp_Object values); - extern bool x_handle_dnd_message (struct frame *, const XClientMessageEvent *, struct x_display_info *, @@ -1570,7 +1580,8 @@ extern bool x_dnd_in_progress; extern struct frame *x_dnd_frame; #ifdef HAVE_XINPUT2 -struct xi_device_t *xi_device_from_id (struct x_display_info *, int); +extern struct xi_device_t *xi_device_from_id (struct x_display_info *, int); +extern bool xi_frame_selected_for (struct frame *, unsigned long); #endif extern void mark_xterm (void); diff --git a/test/lisp/calc/calc-tests.el b/test/lisp/calc/calc-tests.el index 892fd278df8..56cb9057ed9 100644 --- a/test/lisp/calc/calc-tests.el +++ b/test/lisp/calc/calc-tests.el @@ -38,7 +38,7 @@ ;; be used to compare such calc expressions. (defun calc-tests-equal (a b) "Like `equal' but allow for different representations of numbers. -For example: (calc-tests-equal 10 '(float 1 1)) => t. +For example: (calc-tests-equal 10 \\='(float 1 1)) => t. A and B should be calc expressions." (cond ((math-numberp a) (and (math-numberp b) diff --git a/test/lisp/calendar/time-date-tests.el b/test/lisp/calendar/time-date-tests.el index 5a37c914931..fd4d5ac8a1b 100644 --- a/test/lisp/calendar/time-date-tests.el +++ b/test/lisp/calendar/time-date-tests.el @@ -88,14 +88,19 @@ (ert-deftest test-format-seconds () (should (equal (format-seconds "%y %d %h %m %s %%" 0) "0 0 0 0 0 %")) (should (equal (format-seconds "%y %d %h %m %s %%" 9999999) "0 115 17 46 39 %")) - (should (equal (format-seconds "%y %d %h %m %z %s %%" 1) " 1 %")) + (should (equal (format-seconds "%y %d %h %m %z %s %%" 1) "1 %")) (should (equal (format-seconds "%mm %ss" 66) "1m 6s")) (should (equal (format-seconds "%mm %5ss" 66) "1m 6s")) (should (equal (format-seconds "%mm %.5ss" 66.4) "1m 00006s")) (should (equal (format-seconds "%mm %,1ss" 66.4) "1m 6.4s")) (should (equal (format-seconds "%mm %5,1ss" 66.4) "1m 6.4s")) - (should (equal (format-seconds "%mm %.5,1ss" 66.4) "1m 006.4s"))) + (should (equal (format-seconds "%mm %.5,1ss" 66.4) "1m 006.4s")) + + (should (equal (format-seconds "%hh %z%x%mm %ss" (* 60 2)) "2m")) + (should (equal (format-seconds "%hh %z%mm %ss" (* 60 2)) "2m 0s")) + (should (equal (format-seconds "%hh %x%mm %ss" (* 60 2)) "0h 2m")) + (should (equal (format-seconds "%hh %x%mm %ss" 0) "0h 0m 0s"))) (ert-deftest test-ordinal () (should (equal (date-ordinal-to-time 2008 271) diff --git a/test/lisp/cedet/srecode-utest-template.el b/test/lisp/cedet/srecode-utest-template.el index 1eb91e6053b..87c28c6af12 100644 --- a/test/lisp/cedet/srecode-utest-template.el +++ b/test/lisp/cedet/srecode-utest-template.el @@ -33,7 +33,7 @@ ;;; MAP DUMP TESTING (defun srecode-utest-map-reset () "Reset, then dump the map of SRecoder templates. -Probably should be called 'describe-srecode-maps'." +Probably should be called `describe-srecode-maps'." (interactive) (message "SRecode Template Path: %S" srecode-map-load-path) ;; Interactive call allows us to dump. diff --git a/test/lisp/emacs-lisp/nadvice-tests.el b/test/lisp/emacs-lisp/nadvice-tests.el index f21624cfd87..a675986b90b 100644 --- a/test/lisp/emacs-lisp/nadvice-tests.el +++ b/test/lisp/emacs-lisp/nadvice-tests.el @@ -153,13 +153,13 @@ function being an around advice." (ert-deftest advice-test-call-interactively () "Check interaction between advice on call-interactively and called-interactively-p." - (defun sm-test7.4 () (interactive) (cons 1 (called-interactively-p))) - (let ((old (symbol-function 'call-interactively))) + (let ((sm-test7.4 (lambda () (interactive) (cons 1 (called-interactively-p)))) + (old (symbol-function 'call-interactively))) (unwind-protect (progn (advice-add 'call-interactively :before #'ignore) - (should (equal (sm-test7.4) '(1 . nil))) - (should (equal (call-interactively 'sm-test7.4) '(1 . t)))) + (should (equal (funcall sm-test7.4) '(1 . nil))) + (should (equal (call-interactively sm-test7.4) '(1 . t)))) (advice-remove 'call-interactively #'ignore) (should (eq (symbol-function 'call-interactively) old))))) @@ -204,6 +204,15 @@ function being an around advice." (remove-function (var sm-test10) sm-advice) (should (equal (funcall sm-test10 5) 15)))) +(ert-deftest advice-test-print () + (let ((x (list 'cdr))) + (add-function :after (car x) 'car) + (should (equal (cl-prin1-to-string (car x)) + "#f(advice car :after cdr)")) + (add-function :before (car x) 'first) + (should (equal (cl-prin1-to-string (car x)) + "#f(advice first :before #f(advice car :after cdr))")))) + ;; Local Variables: ;; no-byte-compile: t ;; End: diff --git a/test/lisp/emacs-lisp/oclosure-tests.el b/test/lisp/emacs-lisp/oclosure-tests.el index b6bdebc0a2b..b3a921826b1 100644 --- a/test/lisp/emacs-lisp/oclosure-tests.el +++ b/test/lisp/emacs-lisp/oclosure-tests.el @@ -106,6 +106,27 @@ (and (eq 'error (car err)) (string-match "Duplicate slot: fst$" (cadr err))))))) +(cl-defmethod oclosure-interactive-form ((ot oclosure-test)) + (let ((snd (oclosure-test--snd ot))) + (if (stringp snd) (list 'interactive snd)))) + +(ert-deftest oclosure-test-interactive-form () + (should (equal (interactive-form + (oclosure-lambda (oclosure-test (fst 1) (snd 2)) () fst)) + nil)) + (should (equal (interactive-form + (oclosure-lambda (oclosure-test (fst 1) (snd 2)) () + (interactive "r") + fst)) + '(interactive "r"))) + (should (equal (interactive-form + (oclosure-lambda (oclosure-test (fst 1) (snd "P")) () fst)) + '(interactive "P"))) + (should (not (commandp + (oclosure-lambda (oclosure-test (fst 1) (snd 2)) () fst)))) + (should (commandp + (oclosure-lambda (oclosure-test (fst 1) (snd "P")) () fst)))) + (oclosure-define (oclosure-test-mut (:parent oclosure-test) (:copier oclosure-test-mut-copy)) diff --git a/test/lisp/emacs-lisp/subr-x-tests.el b/test/lisp/emacs-lisp/subr-x-tests.el index d38a8e2352b..7f3916c2c0b 100644 --- a/test/lisp/emacs-lisp/subr-x-tests.el +++ b/test/lisp/emacs-lisp/subr-x-tests.el @@ -712,5 +712,37 @@ (loop (cdr rest) (+ sum (car rest)))))) (should (equal (mapcar #'funcall funs) '(43 1 0))))) +(ert-deftest test-with-buffer-unmodified-if-unchanged () + (with-temp-buffer + (with-buffer-unmodified-if-unchanged + (insert "t")) + (should (buffer-modified-p))) + + (with-temp-buffer + (with-buffer-unmodified-if-unchanged + (insert "t") + (delete-char -1)) + (should-not (buffer-modified-p))) + + ;; Shouldn't error. + (should + (with-temp-buffer + (with-buffer-unmodified-if-unchanged + (insert "t") + (delete-char -1) + (kill-buffer)))) + + (with-temp-buffer + (let ((outer (current-buffer))) + (with-temp-buffer + (let ((inner (current-buffer))) + (with-buffer-unmodified-if-unchanged + (insert "t") + (delete-char -1) + (set-buffer outer)) + (with-current-buffer inner + (should-not (buffer-modified-p)))))))) + + (provide 'subr-x-tests) ;;; subr-x-tests.el ends here diff --git a/test/lisp/eshell/em-extpipe-tests.el b/test/lisp/eshell/em-extpipe-tests.el index 91c2fba4791..3b84d763ac6 100644 --- a/test/lisp/eshell/em-extpipe-tests.el +++ b/test/lisp/eshell/em-extpipe-tests.el @@ -170,7 +170,7 @@ (em-extpipe-tests--deftest em-extpipe-test-13 "foo*|bar" (should-parse '(eshell-execute-pipeline - '((eshell-named-command (concat "foo" "*")) + '((eshell-named-command (eshell-concat nil "foo" "*")) (eshell-named-command "bar"))))) (em-extpipe-tests--deftest em-extpipe-test-14 "tac *<temp" diff --git a/test/lisp/eshell/em-glob-tests.el b/test/lisp/eshell/em-glob-tests.el new file mode 100644 index 00000000000..9976b32ffe7 --- /dev/null +++ b/test/lisp/eshell/em-glob-tests.el @@ -0,0 +1,171 @@ +;;; em-glob-tests.el --- em-glob test suite -*- lexical-binding:t -*- + +;; Copyright (C) 2022 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Tests for Eshell's glob expansion. + +;;; Code: + +(require 'ert) +(require 'em-glob) + +(defmacro with-fake-files (files &rest body) + "Evaluate BODY forms, pretending that FILES exist on the filesystem. +FILES is a list of file names that should be reported as +appropriate by `file-name-all-completions'. Any file name +component ending in \"symlink\" is treated as a symbolic link." + (declare (indent 1)) + `(cl-letf (((symbol-function 'file-name-all-completions) + (lambda (file directory) + (cl-assert (string= file "")) + (setq directory (expand-file-name directory)) + `("./" "../" + ,@(delete-dups + (remq nil + (mapcar + (lambda (file) + (setq file (expand-file-name file)) + (when (string-prefix-p directory file) + (replace-regexp-in-string + "/.*" "/" + (substring file (length directory))))) + ,files)))))) + ((symbol-function 'file-symlink-p) + (lambda (file) + (string-suffix-p "symlink" file)))) + ,@body)) + +;;; Tests: + +(ert-deftest em-glob-test/match-any-string () + "Test that \"*\" pattern matches any string." + (with-fake-files '("a.el" "b.el" "c.txt" "dir/a.el") + (should (equal (eshell-extended-glob "*.el") + '("a.el" "b.el"))))) + +(ert-deftest em-glob-test/match-any-character () + "Test that \"?\" pattern matches any character." + (with-fake-files '("a.el" "b.el" "ccc.el" "d.txt" "dir/a.el") + (should (equal (eshell-extended-glob "?.el") + '("a.el" "b.el"))))) + +(ert-deftest em-glob-test/match-recursive () + "Test that \"**/\" recursively matches directories." + (with-fake-files '("a.el" "b.el" "ccc.el" "d.txt" "dir/a.el" "dir/sub/a.el" + "dir/symlink/a.el" "symlink/a.el" "symlink/sub/a.el") + (should (equal (eshell-extended-glob "**/a.el") + '("a.el" "dir/a.el" "dir/sub/a.el"))))) + +(ert-deftest em-glob-test/match-recursive-follow-symlinks () + "Test that \"***/\" recursively matches directories, following symlinks." + (with-fake-files '("a.el" "b.el" "ccc.el" "d.txt" "dir/a.el" "dir/sub/a.el" + "dir/symlink/a.el" "symlink/a.el" "symlink/sub/a.el") + (should (equal (eshell-extended-glob "***/a.el") + '("a.el" "dir/a.el" "dir/sub/a.el" "dir/symlink/a.el" + "symlink/a.el" "symlink/sub/a.el"))))) + +(ert-deftest em-glob-test/match-recursive-mixed () + "Test combination of \"**/\" and \"***/\"." + (with-fake-files '("dir/a.el" "dir/sub/a.el" "dir/sub2/a.el" + "dir/symlink/a.el" "dir/sub/symlink/a.el" "symlink/a.el" + "symlink/sub/a.el" "symlink/sub/symlink/a.el") + (should (equal (eshell-extended-glob "**/sub/***/a.el") + '("dir/sub/a.el" "dir/sub/symlink/a.el"))) + (should (equal (eshell-extended-glob "***/sub/**/a.el") + '("dir/sub/a.el" "symlink/sub/a.el"))))) + +(ert-deftest em-glob-test/match-character-set-individual () + "Test \"[...]\" for individual characters." + (with-fake-files '("a.el" "b.el" "c.el" "d.el" "dir/a.el") + (should (equal (eshell-extended-glob "[ab].el") + '("a.el" "b.el"))) + (should (equal (eshell-extended-glob "[^ab].el") + '("c.el" "d.el"))))) + +(ert-deftest em-glob-test/match-character-set-range () + "Test \"[...]\" for character ranges." + (with-fake-files '("a.el" "b.el" "c.el" "d.el" "dir/a.el") + (should (equal (eshell-extended-glob "[a-c].el") + '("a.el" "b.el" "c.el"))) + (should (equal (eshell-extended-glob "[^a-c].el") + '("d.el"))))) + +(ert-deftest em-glob-test/match-character-set-class () + "Test \"[...]\" for character classes." + (with-fake-files '("1.el" "a.el" "b.el" "c.el" "dir/a.el") + (should (equal (eshell-extended-glob "[[:alpha:]].el") + '("a.el" "b.el" "c.el"))) + (should (equal (eshell-extended-glob "[^[:alpha:]].el") + '("1.el"))))) + +(ert-deftest em-glob-test/match-character-set-mixed () + "Test \"[...]\" with multiple kinds of members at once." + (with-fake-files '("1.el" "a.el" "b.el" "c.el" "d.el" "dir/a.el") + (should (equal (eshell-extended-glob "[ac-d[:digit:]].el") + '("1.el" "a.el" "c.el" "d.el"))) + (should (equal (eshell-extended-glob "[^ac-d[:digit:]].el") + '("b.el"))))) + +(ert-deftest em-glob-test/match-group-alternative () + "Test \"(x|y)\" matches either \"x\" or \"y\"." + (with-fake-files '("em-alias.el" "em-banner.el" "esh-arg.el" "misc.el" + "test/em-xtra.el") + (should (equal (eshell-extended-glob "e(m|sh)-*.el") + '("em-alias.el" "em-banner.el" "esh-arg.el"))))) + +(ert-deftest em-glob-test/match-n-or-more-characters () + "Test that \"x#\" and \"x#\" match zero or more instances of \"x\"." + (with-fake-files '("h.el" "ha.el" "hi.el" "hii.el" "dir/hi.el") + (should (equal (eshell-extended-glob "hi#.el") + '("h.el" "hi.el" "hii.el"))) + (should (equal (eshell-extended-glob "hi##.el") + '("hi.el" "hii.el"))))) + +(ert-deftest em-glob-test/match-n-or-more-groups () + "Test that \"(x)#\" and \"(x)#\" match zero or more instances of \"(x)\"." + (with-fake-files '("h.el" "ha.el" "hi.el" "hii.el" "dir/hi.el") + (should (equal (eshell-extended-glob "hi#.el") + '("h.el" "hi.el" "hii.el"))) + (should (equal (eshell-extended-glob "hi##.el") + '("hi.el" "hii.el"))))) + +(ert-deftest em-glob-test/match-n-or-more-character-sets () + "Test that \"[x]#\" and \"[x]#\" match zero or more instances of \"[x]\"." + (with-fake-files '("w.el" "wh.el" "wha.el" "whi.el" "whaha.el" "dir/wha.el") + (should (equal (eshell-extended-glob "w[ah]#.el") + '("w.el" "wh.el" "wha.el" "whaha.el"))) + (should (equal (eshell-extended-glob "w[ah]##.el") + '("wh.el" "wha.el" "whaha.el"))))) + +(ert-deftest em-glob-test/match-x-but-not-y () + "Test that \"x~y\" matches \"x\" but not \"y\"." + (with-fake-files '("1" "12" "123" "42" "dir/1") + (should (equal (eshell-extended-glob "[[:digit:]]##~4?") + '("1" "12" "123"))))) + +(ert-deftest em-glob-test/no-matches () + "Test behavior when a glob fails to match any files." + (with-fake-files '("foo.el" "bar.el") + (should (equal (eshell-extended-glob "*.txt") + "*.txt")) + (let ((eshell-error-if-no-glob t)) + (should-error (eshell-extended-glob "*.txt"))))) + +;; em-glob-tests.el ends here diff --git a/test/lisp/eshell/em-pred-tests.el b/test/lisp/eshell/em-pred-tests.el new file mode 100644 index 00000000000..3b50543d69a --- /dev/null +++ b/test/lisp/eshell/em-pred-tests.el @@ -0,0 +1,548 @@ +;;; em-pred-tests.el --- em-pred test suite -*- lexical-binding:t -*- + +;; Copyright (C) 2022 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Tests for Eshell's argument predicates/modifiers. + +;;; Code: + +(require 'ert) +(require 'esh-mode) +(require 'eshell) +(require 'em-pred) + +(require 'eshell-tests-helpers + (expand-file-name "eshell-tests-helpers" + (file-name-directory (or load-file-name + default-directory)))) + +(defvar eshell-test-value nil) + +(defun eshell-eval-predicate (initial-value predicate) + "Evaluate PREDICATE on INITIAL-VALUE, returning the result. +PREDICATE is an Eshell argument predicate/modifier." + (let ((eshell-test-value initial-value)) + (with-temp-eshell + (eshell-insert-command + (format "setq eshell-test-value $eshell-test-value(%s)" predicate))) + eshell-test-value)) + +(defun eshell-parse-file-name-attributes (file) + "Parse a fake FILE name to determine its attributes. +Fake file names are file names beginning with \"/fake/\". This +allows defining file names for fake files with various properties +to query via predicates. Attributes are written as a +comma-separate list of ATTR=VALUE pairs as the file's base name, +like: + + /fake/type=-,modes=0755.el + +The following attributes are recognized: + + * \"type\": A single character describing the file type; + accepts the same values as the first character of the file + modes in `ls -l'. + * \"modes\": The file's permission modes, in octal. + * \"links\": The number of links to this file. + * \"uid\": The UID of the file's owner. + * \"gid\": The UID of the file's group. + * \"atime\": The time the file was last accessed, in seconds + since the UNIX epoch. + * \"mtime\": As \"atime\", but for modification time. + * \"ctime\": As \"atime\", but for inode change time. + * \"size\": The file's size in bytes." + (mapcar (lambda (i) + (pcase (split-string i "=") + (`("modes" ,modes) + (cons 'modes (string-to-number modes 8))) + (`(,(and (or "links" "uid" "gid" "size") key) ,value) + (cons (intern key) (string-to-number value))) + (`(,(and (or "atime" "mtime" "ctime") key) ,value) + (cons (intern key) (time-convert (string-to-number value)))) + (`(,key ,value) + (cons (intern key) value)) + (_ (error "invalid format %S" i)))) + (split-string (file-name-base file) ","))) + +(defmacro eshell-partial-let-func (overrides &rest body) + "Temporarily bind to FUNCTION-NAMEs and evaluate BODY. +This is roughly analogous to advising functions, but only does so +while BODY is executing, and only calls NEW-FUNCTION if its first +argument is a string beginning with \"/fake/\". + +This allows selectively overriding functions to test file +properties with fake files without altering the functions' +behavior for real files. + +\(fn ((FUNCTION-NAME NEW-FUNCTION) ...) BODY...)" + (declare (indent 1)) + `(cl-letf + ,(mapcar + (lambda (override) + `((symbol-function #',(car override)) + (let ((orig-function (symbol-function #',(car override)))) + (lambda (file &rest rest) + (apply + (if (and (stringp file) (string-prefix-p "/fake/" file)) + ,(cadr override) + orig-function) + file rest))))) + overrides) + ,@body)) + +(defmacro eshell-with-file-attributes-from-name (&rest body) + "Temporarily override file attribute functions and evaluate BODY." + (declare (indent 0)) + `(eshell-partial-let-func + ((file-attributes + (lambda (file &optional _id-format) + (let ((attrs (eshell-parse-file-name-attributes file))) + (list (equal (alist-get 'type attrs) "d") + (or (alist-get 'links attrs) 1) + (or (alist-get 'uid attrs) 0) + (or (alist-get 'gid attrs) 0) + (or (alist-get 'atime attrs) nil) + (or (alist-get 'mtime attrs) nil) + (or (alist-get 'ctime attrs) nil) + (or (alist-get 'size attrs) 0) + (format "%s---------" (or (alist-get 'type attrs) "-")) + nil 0 0)))) + (file-modes + (lambda (file _nofollow) + (let ((attrs (eshell-parse-file-name-attributes file))) + (or (alist-get 'modes attrs) 0)))) + (file-exists-p #'always) + (file-regular-p + (lambda (file) + (let ((attrs (eshell-parse-file-name-attributes file))) + (member (or (alist-get 'type attrs) "-") '("-" "l"))))) + (file-symlink-p + (lambda (file) + (let ((attrs (eshell-parse-file-name-attributes file))) + (equal (alist-get 'type attrs) "l")))) + (file-executable-p + (lambda (file) + (let ((attrs (eshell-parse-file-name-attributes file))) + ;; For simplicity, just return whether the file is + ;; world-executable. + (= (logand (or (alist-get 'modes attrs) 0) 1) 1))))) + ,@body)) + +;;; Tests: + + +;; Argument predicates + +(ert-deftest em-pred-test/predicate-file-types () + "Test file type predicates." + (eshell-with-file-attributes-from-name + (let ((files (mapcar (lambda (i) (format "/fake/type=%s" i)) + '("b" "c" "d/" "p" "s" "l" "-")))) + (should (equal (eshell-eval-predicate files "%") + '("/fake/type=b" "/fake/type=c"))) + (should (equal (eshell-eval-predicate files "%b") '("/fake/type=b"))) + (should (equal (eshell-eval-predicate files "%c") '("/fake/type=c"))) + (should (equal (eshell-eval-predicate files "/") '("/fake/type=d/"))) + (should (equal (eshell-eval-predicate files ".") '("/fake/type=-"))) + (should (equal (eshell-eval-predicate files "p") '("/fake/type=p"))) + (should (equal (eshell-eval-predicate files "=") '("/fake/type=s"))) + (should (equal (eshell-eval-predicate files "@") '("/fake/type=l")))))) + +(ert-deftest em-pred-test/predicate-executable () + "Test that \"*\" matches only regular, non-symlink executable files." + (eshell-with-file-attributes-from-name + (let ((files '("/fake/modes=0777" "/fake/modes=0666" + "/fake/type=d,modes=0777" "/fake/type=l,modes=0777"))) + (should (equal (eshell-eval-predicate files "*") + '("/fake/modes=0777")))))) + +(defmacro em-pred-test--file-modes-deftest (name mode-template predicates + &optional docstring) + "Define NAME as a file-mode test. +MODE-TEMPLATE is a format string to convert an integer from 0 to +7 to an octal file mode. PREDICATES is a list of strings for the +read, write, and execute predicates to query the file's modes." + (declare (indent 4) (doc-string 4)) + `(ert-deftest ,name () + ,docstring + (eshell-with-file-attributes-from-name + (let ((file-template (concat "/fake/modes=" ,mode-template))) + (cl-flet ((make-files (perms) + (mapcar (lambda (i) (format file-template i)) + perms))) + (pcase-let ((files (make-files (number-sequence 0 7))) + (`(,read ,write ,exec) ,predicates)) + (should (equal (eshell-eval-predicate files read) + (make-files '(4 5 6 7)))) + (should (equal (eshell-eval-predicate files (concat "^" read)) + (make-files '(0 1 2 3)))) + (should (equal (eshell-eval-predicate files write) + (make-files '(2 3 6 7)))) + (should (equal (eshell-eval-predicate files (concat "^" write)) + (make-files '(0 1 4 5)))) + (should (equal (eshell-eval-predicate files exec) + (make-files '(1 3 5 7)))) + (should (equal (eshell-eval-predicate files (concat "^" exec)) + (make-files '(0 2 4 6)))))))))) + +(em-pred-test--file-modes-deftest em-pred-test/predicate-file-modes-owner + "0%o00" '("r" "w" "x") + "Test predicates for file permissions for the owner.") + +(em-pred-test--file-modes-deftest em-pred-test/predicate-file-modes-group + "00%o0" '("A" "I" "E") + "Test predicates for file permissions for the group.") + +(em-pred-test--file-modes-deftest em-pred-test/predicate-file-modes-world + "000%o" '("R" "W" "X") + "Test predicates for file permissions for the world.") + +(em-pred-test--file-modes-deftest em-pred-test/predicate-file-modes-flags + "%o000" '("s" "S" "t") + "Test predicates for \"s\" (setuid), \"S\" (setgid), and \"t\" (sticky).") + +(ert-deftest em-pred-test/predicate-effective-uid () + "Test that \"U\" matches files owned by the effective UID." + (eshell-with-file-attributes-from-name + (cl-letf (((symbol-function 'user-uid) (lambda () 1))) + (let ((files '("/fake/uid=1" "/fake/uid=2"))) + (should (equal (eshell-eval-predicate files "U") + '("/fake/uid=1"))))))) + +(ert-deftest em-pred-test/predicate-effective-gid () + "Test that \"G\" matches files owned by the effective GID." + (eshell-with-file-attributes-from-name + (cl-letf (((symbol-function 'group-gid) (lambda () 1))) + (let ((files '("/fake/gid=1" "/fake/gid=2"))) + (should (equal (eshell-eval-predicate files "G") + '("/fake/gid=1"))))))) + +(ert-deftest em-pred-test/predicate-links () + "Test that \"l\" filters by number of links." + (eshell-with-file-attributes-from-name + (let ((files '("/fake/links=1" "/fake/links=2" "/fake/links=3"))) + (should (equal (eshell-eval-predicate files "l1") + '("/fake/links=1"))) + (should (equal (eshell-eval-predicate files "l+1") + '("/fake/links=2" "/fake/links=3"))) + (should (equal (eshell-eval-predicate files "l-3") + '("/fake/links=1" "/fake/links=2")))))) + +(ert-deftest em-pred-test/predicate-uid () + "Test that \"u\" filters by UID/user name." + (eshell-with-file-attributes-from-name + (let ((files '("/fake/uid=1" "/fake/uid=2")) + (user-names '("root" "one" "two"))) + (should (equal (eshell-eval-predicate files "u1") + '("/fake/uid=1"))) + (cl-letf (((symbol-function 'eshell-user-id) + (lambda (name) (seq-position user-names name)))) + (should (equal (eshell-eval-predicate files "u'one'") + '("/fake/uid=1"))))))) + +(ert-deftest em-pred-test/predicate-gid () + "Test that \"g\" filters by GID/group name." + (eshell-with-file-attributes-from-name + (let ((files '("/fake/gid=1" "/fake/gid=2")) + (group-names '("root" "one" "two"))) + (should (equal (eshell-eval-predicate files "g1") + '("/fake/gid=1"))) + (cl-letf (((symbol-function 'eshell-group-id) + (lambda (name) (seq-position group-names name)))) + (should (equal (eshell-eval-predicate files "g'one'") + '("/fake/gid=1"))))))) + +(defmacro em-pred-test--time-deftest (name file-attribute predicate + &optional docstring) + "Define NAME as a file-time test. +FILE-ATTRIBUTE is the file's attribute to set (e.g. \"atime\"). +PREDICATE is the predicate used to query that attribute." + (declare (indent 4) (doc-string 4)) + `(ert-deftest ,name () + ,docstring + (eshell-with-file-attributes-from-name + (cl-flet ((make-file (time) + (format "/fake/%s=%d" ,file-attribute time))) + (let* ((now (time-convert nil 'integer)) + (yesterday (- now 86400)) + (files (mapcar #'make-file (list now yesterday)))) + ;; Test comparison against a number of days. + (should (equal (eshell-eval-predicate + files (concat ,predicate "-1")) + (mapcar #'make-file (list now)))) + (should (equal (eshell-eval-predicate + files (concat ,predicate "+1")) + (mapcar #'make-file (list yesterday)))) + (should (equal (eshell-eval-predicate + files (concat ,predicate "+2")) + nil)) + ;; Test comparison against a number of hours. + (should (equal (eshell-eval-predicate + files (concat ,predicate "h-1")) + (mapcar #'make-file (list now)))) + (should (equal (eshell-eval-predicate + files (concat ,predicate "h+1")) + (mapcar #'make-file (list yesterday)))) + (should (equal (eshell-eval-predicate + files (concat ,predicate "+48")) + nil)) + ;; Test comparison against another file. + (should (equal (eshell-eval-predicate + files (format "%s-'%s'" ,predicate (make-file now))) + nil)) + (should (equal (eshell-eval-predicate + files (format "%s+'%s'" ,predicate (make-file now))) + (mapcar #'make-file (list yesterday))))))))) + +(em-pred-test--time-deftest em-pred-test/predicate-access-time + "atime" "a" + "Test that \"a\" filters by access time.") + +(em-pred-test--time-deftest em-pred-test/predicate-modification-time + "mtime" "m" + "Test that \"m\" filters by change time.") + +(em-pred-test--time-deftest em-pred-test/predicate-change-time + "ctime" "c" + "Test that \"c\" filters by change time.") + +(ert-deftest em-pred-test/predicate-size () + "Test that \"L\" filters by file size." + (eshell-with-file-attributes-from-name + (let ((files '("/fake/size=0" + ;; 1 and 2 KiB. + "/fake/size=1024" "/fake/size=2048" + ;; 1 and 2 MiB. + "/fake/size=1048576" "/fake/size=2097152"))) + ;; Size in bytes. + (should (equal (eshell-eval-predicate files "L2048") + '("/fake/size=2048"))) + (should (equal (eshell-eval-predicate files "L+2048") + '("/fake/size=1048576" "/fake/size=2097152"))) + (should (equal (eshell-eval-predicate files "L-2048") + '("/fake/size=0" "/fake/size=1024"))) + ;; Size in blocks. + (should (equal (eshell-eval-predicate files "Lp4") + '("/fake/size=2048"))) + (should (equal (eshell-eval-predicate files "Lp+4") + '("/fake/size=1048576" "/fake/size=2097152"))) + (should (equal (eshell-eval-predicate files "Lp-4") + '("/fake/size=0" "/fake/size=1024"))) + ;; Size in KiB. + (should (equal (eshell-eval-predicate files "Lk2") + '("/fake/size=2048"))) + (should (equal (eshell-eval-predicate files "Lk+2") + '("/fake/size=1048576" "/fake/size=2097152"))) + (should (equal (eshell-eval-predicate files "Lk-2") + '("/fake/size=0" "/fake/size=1024"))) + ;; Size in MiB. + (should (equal (eshell-eval-predicate files "LM1") + '("/fake/size=1048576"))) + (should (equal (eshell-eval-predicate files "LM+1") + '("/fake/size=2097152"))) + (should (equal (eshell-eval-predicate files "LM-1") + '("/fake/size=0" "/fake/size=1024" "/fake/size=2048")))))) + + +;; Argument modifiers + +(ert-deftest em-pred-test/modifier-eval () + "Test that \":E\" re-evaluates the value." + (should (equal (eshell-eval-predicate "${echo hi}" ":E") "hi")) + (should (equal (eshell-eval-predicate + '("${echo hi}" "$(upcase \"bye\")") ":E") + '("hi" "BYE")))) + +(ert-deftest em-pred-test/modifier-downcase () + "Test that \":L\" downcases values." + (should (equal (eshell-eval-predicate "FOO" ":L") "foo")) + (should (equal (eshell-eval-predicate '("FOO" "BAR") ":L") + '("foo" "bar")))) + +(ert-deftest em-pred-test/modifier-upcase () + "Test that \":U\" upcases values." + (should (equal (eshell-eval-predicate "foo" ":U") "FOO")) + (should (equal (eshell-eval-predicate '("foo" "bar") ":U") + '("FOO" "BAR")))) + +(ert-deftest em-pred-test/modifier-capitalize () + "Test that \":C\" capitalizes values." + (should (equal (eshell-eval-predicate "foo bar" ":C") "Foo Bar")) + (should (equal (eshell-eval-predicate '("foo bar" "baz") ":C") + '("Foo Bar" "Baz")))) + +(ert-deftest em-pred-test/modifier-dirname () + "Test that \":h\" returns the dirname." + (should (equal (eshell-eval-predicate "/path/to/file.el" ":h") "/path/to/")) + (should (equal (eshell-eval-predicate + '("/path/to/file.el" "/other/path/") ":h") + '("/path/to/" "/other/path/")))) + +(ert-deftest em-pred-test/modifier-basename () + "Test that \":t\" returns the basename." + (should (equal (eshell-eval-predicate "/path/to/file.el" ":t") "file.el")) + (should (equal (eshell-eval-predicate + '("/path/to/file.el" "/other/path/") ":t") + '("file.el" "")))) + +(ert-deftest em-pred-test/modifier-extension () + "Test that \":e\" returns the extension." + (should (equal (eshell-eval-predicate "/path/to/file.el" ":e") "el")) + (should (equal (eshell-eval-predicate + '("/path/to/file.el" "/other/path/") ":e") + '("el" nil)))) + +(ert-deftest em-pred-test/modifier-sans-extension () + "Test that \":r\" returns the file name san extension." + (should (equal (eshell-eval-predicate "/path/to/file.el" ":r") + "/path/to/file")) + (should (equal (eshell-eval-predicate + '("/path/to/file.el" "/other/path/") ":r") + '("/path/to/file" "/other/path/")))) + +(ert-deftest em-pred-test/modifier-quote () + "Test that \":q\" quotes arguments." + (should (equal-including-properties + (eshell-eval-predicate '("foo" "bar") ":q") + (list (eshell-escape-arg "foo") (eshell-escape-arg "bar"))))) + +(ert-deftest em-pred-test/modifier-substitute () + "Test that \":s/PAT/REP/\" replaces PAT with REP once." + (should (equal (eshell-eval-predicate "bar" ":s/a/*/") "b*r")) + (should (equal (eshell-eval-predicate "bar" ":s|a|*|") "b*r")) + (should (equal (eshell-eval-predicate "bar" ":s{a}{*}") "b*r")) + (should (equal (eshell-eval-predicate "bar" ":s{a}'*'") "b*r")) + (should (equal (eshell-eval-predicate '("foo" "bar" "baz") ":s/[ao]/*/") + '("f*o" "b*r" "b*z"))) + (should (equal (eshell-eval-predicate '("foo" "bar" "baz") ":s|[ao]|*|") + '("f*o" "b*r" "b*z")))) + +(ert-deftest em-pred-test/modifier-global-substitute () + "Test that \":s/PAT/REP/\" replaces PAT with REP for all occurrences." + (should (equal (eshell-eval-predicate "foo" ":gs/a/*/") "foo")) + (should (equal (eshell-eval-predicate "foo" ":gs|a|*|") "foo")) + (should (equal (eshell-eval-predicate "bar" ":gs/a/*/") "b*r")) + (should (equal (eshell-eval-predicate "bar" ":gs|a|*|") "b*r")) + (should (equal (eshell-eval-predicate "foo" ":gs/o/O/") "fOO")) + (should (equal (eshell-eval-predicate '("foo" "bar" "baz") ":gs/[aeiou]/*/") + '("f**" "b*r" "b*z"))) + (should (equal (eshell-eval-predicate '("foo" "bar" "baz") ":gs|[aeiou]|*|") + '("f**" "b*r" "b*z")))) + +(ert-deftest em-pred-test/modifier-include () + "Test that \":i/PAT/\" filters elements to include only ones matching PAT." + (should (equal (eshell-eval-predicate "foo" ":i/a/") nil)) + (should (equal (eshell-eval-predicate "bar" ":i/a/") "bar")) + (should (equal (eshell-eval-predicate '("foo" "bar" "baz") ":i/a/") + '("bar" "baz")))) + +(ert-deftest em-pred-test/modifier-exclude () + "Test that \":x/PAT/\" filters elements to exclude any matching PAT." + (should (equal (eshell-eval-predicate "foo" ":x/a/") "foo")) + (should (equal (eshell-eval-predicate "bar" ":x/a/") nil)) + (should (equal (eshell-eval-predicate '("foo" "bar" "baz") ":x/a/") + '("foo")))) + +(ert-deftest em-pred-test/modifier-split () + "Test that \":S\" and \":S/PAT/\" split elements by spaces (or PAT)." + (should (equal (eshell-eval-predicate "foo bar baz" ":S") + '("foo" "bar" "baz"))) + (should (equal (eshell-eval-predicate '("foo bar" "baz") ":S") + '(("foo" "bar") ("baz")))) + (should (equal (eshell-eval-predicate "foo-bar-baz" ":S/-/") + '("foo" "bar" "baz"))) + (should (equal (eshell-eval-predicate '("foo-bar" "baz") ":S/-/") + '(("foo" "bar") ("baz"))))) + +(ert-deftest em-pred-test/modifier-join () + "Test that \":j\" and \":j/DELIM/\" join elements by spaces (or DELIM)." + (should (equal (eshell-eval-predicate "foo" ":j") "foo")) + (should (equal (eshell-eval-predicate '("foo" "bar" "baz") ":j") + "foo bar baz")) + (should (equal (eshell-eval-predicate "foo" ":j/-/") "foo")) + (should (equal (eshell-eval-predicate '("foo" "bar" "baz") ":j/-/") + "foo-bar-baz"))) + +(ert-deftest em-pred-test/modifier-sort () + "Test that \":o\" sorts elements in lexicographic order." + (should (equal (eshell-eval-predicate "foo" ":o") "foo")) + (should (equal (eshell-eval-predicate '("foo" "bar" "baz") ":o") + '("bar" "baz" "foo")))) + +(ert-deftest em-pred-test/modifier-sort-reverse () + "Test that \":o\" sorts elements in reverse lexicographic order." + (should (equal (eshell-eval-predicate "foo" ":O") "foo")) + (should (equal (eshell-eval-predicate '("foo" "bar" "baz") ":O") + '("foo" "baz" "bar")))) + +(ert-deftest em-pred-test/modifier-unique () + "Test that \":u\" filters out duplicate elements." + (should (equal (eshell-eval-predicate "foo" ":u") "foo")) + (should (equal (eshell-eval-predicate '("foo" "bar" "baz") ":u") + '("foo" "bar" "baz"))) + (should (equal (eshell-eval-predicate '("foo" "bar" "baz" "foo") ":u") + '("foo" "bar" "baz")))) + +(ert-deftest em-pred-test/modifier-reverse () + "Test that \":r\" reverses the order of elements." + (should (equal (eshell-eval-predicate "foo" ":R") "foo")) + (should (equal (eshell-eval-predicate '("foo" "bar" "baz") ":R") + '("baz" "bar" "foo")))) + + +;; Miscellaneous + +(ert-deftest em-pred-test/combine-predicate-and-modifier () + "Test combination of predicates and modifiers." + (eshell-with-file-attributes-from-name + (let ((files '("/fake/type=-.el" "/fake/type=-.txt" "/fake/type=s.el" + "/fake/subdir/type=-.el"))) + (should (equal (eshell-eval-predicate files ".:e:u") + '("el" "txt")))))) + +(ert-deftest em-pred-test/predicate-delimiters () + "Test various delimiter pairs with predicates and modifiers." + (dolist (delims eshell-pred-delimiter-pairs) + (eshell-with-file-attributes-from-name + (let ((files '("/fake/uid=1" "/fake/uid=2")) + (user-names '("root" "one" "two"))) + (cl-letf (((symbol-function 'eshell-user-id) + (lambda (name) (seq-position user-names name)))) + (should (equal (eshell-eval-predicate + files (format "u%cone%c" (car delims) (cdr delims))) + '("/fake/uid=1")))))) + (should (equal (eshell-eval-predicate + '("foo" "bar" "baz") + (format ":j%c-%c" (car delims) (cdr delims))) + "foo-bar-baz")))) + +(ert-deftest em-pred-test/predicate-escaping () + "Test string escaping in predicate and modifier parameters." + ;; Escaping the delimiter should remove the backslash. + (should (equal (eshell-eval-predicate '("foo" "bar" "baz") ":j'\\''") + "foo'bar'baz")) + ;; Escaping a backlash should remove the first backslash. + (should (equal (eshell-eval-predicate '("foo" "bar" "baz") ":j'\\\\'") + "foo\\bar\\baz")) + ;; Escaping a different character should keep the backslash. + (should (equal (eshell-eval-predicate '("foo" "bar" "baz") ":j'\\\"'") + "foo\\\"bar\\\"baz"))) + +;; em-pred-tests.el ends here diff --git a/test/lisp/eshell/esh-var-tests.el b/test/lisp/eshell/esh-var-tests.el index 1d051d681af..4e2a18861e5 100644 --- a/test/lisp/eshell/esh-var-tests.el +++ b/test/lisp/eshell/esh-var-tests.el @@ -176,8 +176,17 @@ (should (equal (eshell-test-command-result "+ $(+ 1 2)$(+ 1 2) 3") 36))) (ert-deftest esh-var-test/interp-concat-cmd () - "Interpolate and concat command" - (should (equal (eshell-test-command-result "+ ${+ 1 2}3 3") 36))) + "Interpolate and concat command with literal" + (should (equal (eshell-test-command-result "+ ${+ 1 2}3 3") 36)) + (should (equal (eshell-test-command-result "echo ${*echo \"foo\nbar\"}-baz") + '("foo" "bar-baz"))) + ;; Concatenating to a number in a list should produce a number... + (should (equal (eshell-test-command-result "echo ${*echo \"1\n2\"}3") + '(1 23))) + ;; ... but concatenating to a string that looks like a number in a list + ;; should produce a string. + (should (equal (eshell-test-command-result "echo ${*echo \"hi\n2\"}3") + '("hi" "23")))) (ert-deftest esh-var-test/interp-concat-cmd2 () "Interpolate and concat two commands" @@ -210,12 +219,17 @@ (should (equal (eshell-test-command-result "echo \"$eshell-test-value[0]\"") "zero")) + ;; FIXME: These tests would use the 0th index like the other tests + ;; here, but evaluating the command just above adds an `escaped' + ;; property to the string "zero". This results in the output + ;; printing the string properties, which is probably the wrong + ;; behavior. See bug#54486. (should (equal (eshell-test-command-result - "echo \"$eshell-test-value[0 2]\"") - '("zero" "two"))) + "echo \"$eshell-test-value[1 2]\"") + "(\"one\" \"two\")")) (should (equal (eshell-test-command-result - "echo \"$eshell-test-value[0 2 4]\"") - '("zero" "two" "four"))))) + "echo \"$eshell-test-value[1 2 4]\"") + "(\"one\" \"two\" \"four\")")))) (ert-deftest esh-var-test/quoted-interp-var-split-indices () "Interpolate string variable with indices inside double-quotes" @@ -225,7 +239,7 @@ "zero")) (should (equal (eshell-test-command-result "echo \"$eshell-test-value[0 2]\"") - '("zero" "two"))))) + "(\"zero\" \"two\")")))) (ert-deftest esh-var-test/quoted-interp-var-string-split-indices () "Interpolate string variable with string splitter and indices @@ -236,14 +250,14 @@ inside double-quotes" "zero")) (should (equal (eshell-test-command-result "echo \"$eshell-test-value[: 0 2]\"") - '("zero" "two")))) + "(\"zero\" \"two\")"))) (let ((eshell-test-value "zeroXoneXtwoXthreeXfour")) (should (equal (eshell-test-command-result "echo \"$eshell-test-value[X 0]\"") "zero")) (should (equal (eshell-test-command-result "echo \"$eshell-test-value[X 0 2]\"") - '("zero" "two"))))) + "(\"zero\" \"two\")")))) (ert-deftest esh-var-test/quoted-interp-var-regexp-split-indices () "Interpolate string variable with regexp splitter and indices" @@ -253,43 +267,47 @@ inside double-quotes" "zero")) (should (equal (eshell-test-command-result "echo \"$eshell-test-value['[:!]' 0 2]\"") - '("zero" "two"))) + "(\"zero\" \"two\")")) (should (equal (eshell-test-command-result "echo \"$eshell-test-value[\\\"[:!]\\\" 0]\"") "zero")) (should (equal (eshell-test-command-result "echo \"$eshell-test-value[\\\"[:!]\\\" 0 2]\"") - '("zero" "two"))))) + "(\"zero\" \"two\")")))) (ert-deftest esh-var-test/quoted-interp-var-assoc () "Interpolate alist variable with index inside double-quotes" (let ((eshell-test-value '(("foo" . 1)))) (should (equal (eshell-test-command-result "echo \"$eshell-test-value[foo]\"") - 1)))) + "1")))) (ert-deftest esh-var-test/quoted-interp-var-length-list () "Interpolate length of list variable inside double-quotes" (let ((eshell-test-value '((1 2) (3) (5 (6 7 8 9))))) - (should (eq (eshell-test-command-result "echo \"$#eshell-test-value\"") 3)) - (should (eq (eshell-test-command-result "echo \"$#eshell-test-value[1]\"") - 1)) - (should (eq (eshell-test-command-result - "echo \"$#eshell-test-value[2][1]\"") - 4)))) + (should (equal (eshell-test-command-result "echo \"$#eshell-test-value\"") + "3")) + (should (equal (eshell-test-command-result + "echo \"$#eshell-test-value[1]\"") + "1")) + (should (equal (eshell-test-command-result + "echo \"$#eshell-test-value[2][1]\"") + "4")))) (ert-deftest esh-var-test/quoted-interp-var-length-string () "Interpolate length of string variable inside double-quotes" (let ((eshell-test-value "foobar")) - (should (eq (eshell-test-command-result "echo \"$#eshell-test-value\"") - 6)))) + (should (equal (eshell-test-command-result "echo \"$#eshell-test-value\"") + "6")))) (ert-deftest esh-var-test/quoted-interp-var-length-alist () "Interpolate length of alist variable inside double-quotes" (let ((eshell-test-value '(("foo" . (1 2 3))))) - (should (eq (eshell-test-command-result "echo \"$#eshell-test-value\"") 1)) - (should (eq (eshell-test-command-result "echo \"$#eshell-test-value[foo]\"") - 3)))) + (should (equal (eshell-test-command-result "echo \"$#eshell-test-value\"") + "1")) + (should (equal (eshell-test-command-result + "echo \"$#eshell-test-value[foo]\"") + "3")))) (ert-deftest esh-var-test/quoted-interp-lisp () "Interpolate Lisp form evaluation inside double-quotes" @@ -299,7 +317,8 @@ inside double-quotes" (ert-deftest esh-var-test/quoted-interp-lisp-indices () "Interpolate Lisp form evaluation with index" - (should (equal (eshell-test-command-result "+ \"$(list 1 2)[1]\" 3") 5))) + (should (equal (eshell-test-command-result "concat \"$(list 1 2)[1]\" cool") + "2cool"))) (ert-deftest esh-var-test/quoted-interp-cmd () "Interpolate command result inside double-quotes" @@ -309,11 +328,143 @@ inside double-quotes" (ert-deftest esh-var-test/quoted-interp-cmd-indices () "Interpolate command result with index inside double-quotes" - (should (equal (eshell-test-command-result "+ \"${list 1 2}[1]\" 3") 5))) + (should (equal (eshell-test-command-result "concat \"${list 1 2}[1]\" cool") + "2cool"))) (ert-deftest esh-var-test/quoted-interp-temp-cmd () "Interpolate command result redirected to temp file inside double-quotes" - (should (equal (eshell-test-command-result "cat \"$<echo hi>\"") "hi"))) + (let ((temporary-file-directory + (file-name-as-directory (make-temp-file "esh-vars-tests" t)))) + (unwind-protect + (should (equal (eshell-test-command-result "cat \"$<echo hi>\"") + "hi")) + (delete-directory temporary-file-directory t)))) + +(ert-deftest esh-var-test/quoted-interp-concat-cmd () + "Interpolate and concat command with literal" + (should (equal (eshell-test-command-result + "echo \"${echo \\\"foo\nbar\\\"} baz\"") + "foo\nbar baz"))) + + +;; Interpolated variable conversion + +(ert-deftest esh-var-test/interp-convert-var-number () + "Interpolate numeric variable" + (let ((eshell-test-value 123)) + (should (equal (eshell-test-command-result "type-of $eshell-test-value") + 'integer)))) + +(ert-deftest esh-var-test/interp-convert-var-split-indices () + "Interpolate and convert string variable with indices" + (let ((eshell-test-value "000 010 020 030 040")) + (should (equal (eshell-test-command-result "echo $eshell-test-value[0]") + 0)) + (should (equal (eshell-test-command-result "echo $eshell-test-value[0 2]") + '(0 20))))) + +(ert-deftest esh-var-test/interp-convert-quoted-var-number () + "Interpolate numeric quoted numeric variable" + (let ((eshell-test-value 123)) + (should (equal (eshell-test-command-result "type-of $'eshell-test-value'") + 'integer)) + (should (equal (eshell-test-command-result "type-of $\"eshell-test-value\"") + 'integer)))) + +(ert-deftest esh-var-test/interp-convert-quoted-var-split-indices () + "Interpolate and convert quoted string variable with indices" + (let ((eshell-test-value "000 010 020 030 040")) + (should (equal (eshell-test-command-result "echo $'eshell-test-value'[0]") + 0)) + (should (equal (eshell-test-command-result "echo $'eshell-test-value'[0 2]") + '(0 20))))) + +(ert-deftest esh-var-test/interp-convert-cmd-string-newline () + "Interpolate trailing-newline command result" + (should (equal (eshell-test-command-result "echo ${echo \"foo\n\"}") "foo"))) + +(ert-deftest esh-var-test/interp-convert-cmd-multiline () + "Interpolate multi-line command result" + (should (equal (eshell-test-command-result "echo ${echo \"foo\nbar\"}") + '("foo" "bar"))) + ;; Numeric output should be converted to numbers... + (should (equal (eshell-test-command-result "echo ${echo \"01\n02\n03\"}") + '(1 2 3))) + ;; ... but only if every line is numeric. + (should (equal (eshell-test-command-result "echo ${echo \"01\n02\nhi\"}") + '("01" "02" "hi")))) + +(ert-deftest esh-var-test/interp-convert-cmd-number () + "Interpolate numeric command result" + (should (equal (eshell-test-command-result "echo ${echo \"1\"}") 1))) + +(ert-deftest esh-var-test/interp-convert-cmd-split-indices () + "Interpolate command result with indices" + (should (equal (eshell-test-command-result "echo ${echo \"000 010 020\"}[0]") + 0)) + (should (equal (eshell-test-command-result + "echo ${echo \"000 010 020\"}[0 2]") + '(0 20)))) + +(ert-deftest esh-var-test/quoted-interp-convert-var-number () + "Interpolate numeric variable inside double-quotes" + (let ((eshell-test-value 123)) + (should (equal (eshell-test-command-result "type-of \"$eshell-test-value\"") + 'string)))) + +(ert-deftest esh-var-test/quoted-interp-convert-var-split-indices () + "Interpolate string variable with indices inside double-quotes" + (let ((eshell-test-value "000 010 020 030 040")) + (should (equal (eshell-test-command-result + "echo \"$eshell-test-value[0]\"") + "000")) + (should (equal (eshell-test-command-result + "echo \"$eshell-test-value[0 2]\"") + "(\"000\" \"020\")")))) + +(ert-deftest esh-var-test/quoted-interp-convert-quoted-var-number () + "Interpolate numeric quoted variable inside double-quotes" + (let ((eshell-test-value 123)) + (should (equal (eshell-test-command-result + "type-of \"$'eshell-test-value'\"") + 'string)) + (should (equal (eshell-test-command-result + "type-of \"$\\\"eshell-test-value\\\"\"") + 'string)))) + +(ert-deftest esh-var-test/quoted-interp-convert-quoted-var-split-indices () + "Interpolate quoted string variable with indices inside double-quotes" + (let ((eshell-test-value "000 010 020 030 040")) + (should (equal (eshell-test-command-result + "echo \"$eshell-test-value[0]\"") + "000")) + (should (equal (eshell-test-command-result + "echo \"$eshell-test-value[0 2]\"") + "(\"000\" \"020\")")))) + +(ert-deftest esh-var-test/quoted-interp-convert-cmd-string-newline () + "Interpolate trailing-newline command result inside double-quotes" + (should (equal (eshell-test-command-result "echo \"${echo \\\"foo\n\\\"}\"") + "foo")) + (should (equal (eshell-test-command-result "echo \"${echo \\\"foo\n\n\\\"}\"") + "foo"))) + +(ert-deftest esh-var-test/quoted-interp-convert-cmd-multiline () + "Interpolate multi-line command result inside double-quotes" + (should (equal (eshell-test-command-result + "echo \"${echo \\\"foo\nbar\\\"}\"") + "foo\nbar"))) + +(ert-deftest esh-var-test/quoted-interp-convert-cmd-number () + "Interpolate numeric command result inside double-quotes" + (should (equal (eshell-test-command-result "echo \"${echo \\\"1\\\"}\"") + "1"))) + +(ert-deftest esh-var-test/quoted-interp-convert-cmd-split-indices () + "Interpolate command result with indices inside double-quotes" + (should (equal (eshell-test-command-result + "echo \"${echo \\\"000 010 020\\\"}[0]\"") + "000"))) ;; Built-in variables diff --git a/test/lisp/eshell/eshell-tests-helpers.el b/test/lisp/eshell/eshell-tests-helpers.el index f944194a2b1..4ad76ca6978 100644 --- a/test/lisp/eshell/eshell-tests-helpers.el +++ b/test/lisp/eshell/eshell-tests-helpers.el @@ -38,17 +38,18 @@ See `eshell-wait-for-subprocess'.") (defmacro with-temp-eshell (&rest body) "Evaluate BODY in a temporary Eshell buffer." - `(ert-with-temp-directory eshell-directory-name - (let* (;; We want no history file, so prevent Eshell from falling - ;; back on $HISTFILE. - (process-environment (cons "HISTFILE" process-environment)) - (eshell-history-file-name nil) - (eshell-buffer (eshell t))) - (unwind-protect - (with-current-buffer eshell-buffer - ,@body) - (let (kill-buffer-query-functions) - (kill-buffer eshell-buffer)))))) + `(save-current-buffer + (ert-with-temp-directory eshell-directory-name + (let* (;; We want no history file, so prevent Eshell from falling + ;; back on $HISTFILE. + (process-environment (cons "HISTFILE" process-environment)) + (eshell-history-file-name nil) + (eshell-buffer (eshell t))) + (unwind-protect + (with-current-buffer eshell-buffer + ,@body) + (let (kill-buffer-query-functions) + (kill-buffer eshell-buffer))))))) (defun eshell-wait-for-subprocess (&optional all) "Wait until there is no interactive subprocess running in Eshell. diff --git a/test/lisp/eshell/eshell-tests.el b/test/lisp/eshell/eshell-tests.el index bcc2dc320b2..7cdeb017e44 100644 --- a/test/lisp/eshell/eshell-tests.el +++ b/test/lisp/eshell/eshell-tests.el @@ -114,6 +114,25 @@ e.g. \"{(+ 1 2)} 3\" => 3" (eshell-wait-for-subprocess) (eshell-match-result "OLLEH\n"))) +(ert-deftest eshell-test/redirect-buffer () + "Check that piping to a buffer works" + (with-temp-buffer + (rename-buffer "eshell-temp-buffer" t) + (let ((bufname (buffer-name))) + (with-temp-eshell + (eshell-insert-command (format "echo hi > #<%s>" bufname))) + (should (equal (buffer-string) "hi"))))) + +(ert-deftest eshell-test/redirect-buffer-escaped () + "Check that piping to a buffer with escaped characters works" + (with-temp-buffer + (rename-buffer "eshell\\temp\\buffer" t) + (let ((bufname (buffer-name))) + (with-temp-eshell + (eshell-insert-command (format "echo hi > #<%s>" + (string-replace "\\" "\\\\" bufname)))) + (should (equal (buffer-string) "hi"))))) + (ert-deftest eshell-test/inside-emacs-var () "Test presence of \"INSIDE_EMACS\" in subprocesses" (with-temp-eshell diff --git a/test/lisp/files-resources/compile-utf8.el b/test/lisp/files-resources/compile-utf8.el new file mode 100644 index 00000000000..ea67626365d --- /dev/null +++ b/test/lisp/files-resources/compile-utf8.el @@ -0,0 +1,11 @@ +(defun zot () + "Yes." + nil) + +(defun foo () + "Yés." + nil) + +(defun bar () + "Nó." + nil) diff --git a/test/lisp/files-resources/file-mode b/test/lisp/files-resources/file-mode new file mode 100644 index 00000000000..92ac4c30ef5 --- /dev/null +++ b/test/lisp/files-resources/file-mode @@ -0,0 +1,3 @@ +Local variables: +mode: text +end: diff --git a/test/lisp/files-resources/file-mode-multiple b/test/lisp/files-resources/file-mode-multiple new file mode 100644 index 00000000000..ac051ccbcbd --- /dev/null +++ b/test/lisp/files-resources/file-mode-multiple @@ -0,0 +1,5 @@ +Local variables: +mode: text +mode: test-mode-undef +mode: outline +end: diff --git a/test/lisp/files-resources/file-mode-prop-line b/test/lisp/files-resources/file-mode-prop-line new file mode 100644 index 00000000000..e0e7ad24d71 --- /dev/null +++ b/test/lisp/files-resources/file-mode-prop-line @@ -0,0 +1 @@ +-*- mode: notexist; mode: text -*- diff --git a/test/lisp/files-tests.el b/test/lisp/files-tests.el index 42b09201de8..7d17fbde672 100644 --- a/test/lisp/files-tests.el +++ b/test/lisp/files-tests.el @@ -263,7 +263,7 @@ form.") nil)) (kill-emacs-args nil) ((symbol-function #'kill-emacs) - (lambda (&optional arg) (push arg kill-emacs-args))) + (lambda (&rest args) (push args kill-emacs-args))) (process (make-process :name "sleep" @@ -274,7 +274,7 @@ form.") (save-buffers-kill-emacs) (kill-process process) (should-not yes-or-no-p-prompts) - (should (equal kill-emacs-args '(nil))))) + (should (equal kill-emacs-args '((nil nil)))))) (ert-deftest files-tests-read-file-in-~ () "Test file prompting in directory named `~'. @@ -1814,5 +1814,51 @@ Prompt users for any modified buffer with `buffer-offer-save' non-nil." (should (equal (file-name-split "/foo/bar/") '("" "foo" "bar" ""))) (should (equal (file-name-split "foo/bar/") '("foo" "bar" "")))) +(ert-deftest files-test-set-mode () + (find-file (ert-resource-file "file-mode")) + (should (eq major-mode 'text-mode)) + (emacs-lisp-mode) + ;; Check that the mode cookie doesn't override the explicit setting. + (should (eq major-mode 'emacs-lisp-mode))) + +(ert-deftest files-test-set-mode-multiple () + (find-file (ert-resource-file "file-mode-multiple")) + (should (eq major-mode 'outline-mode))) + +(ert-deftest files-test-set-mode-prop-line () + (find-file (ert-resource-file "file-mode-prop-line")) + (should (eq major-mode 'text-mode))) + +(ert-deftest files-load-elc-gz-file () + :expected-result :failed + (skip-unless (executable-find "gzip")) + (ert-with-temp-directory dir + (let* ((pref (expand-file-name "compile-utf8" dir)) + (el (concat pref ".el"))) + (copy-file (ert-resource-file "compile-utf8.el") el) + (push dir load-path) + (should (load pref t)) + (should (fboundp 'foo)) + (should (documentation 'foo)) + (should (documentation 'bar)) + (should (documentation 'zot)) + + (byte-compile-file el) + (fmakunbound 'foo) + (should (load (concat pref ".elc") t)) + (should (fboundp 'foo)) + (should (documentation 'foo)) + (should (documentation 'bar)) + (should (documentation 'zot)) + + (dired-compress-file (concat pref ".elc")) + (fmakunbound 'foo) + (should (load (concat pref ".elc.gz") t)) + (should (fboundp 'foo)) + ;; This fails due to bug#12598. + (should (documentation 'foo)) + (should (documentation 'bar)) + (should (documentation 'zot))))) + (provide 'files-tests) ;;; files-tests.el ends here diff --git a/test/lisp/image-tests.el b/test/lisp/image-tests.el index 2b3e818d720..bc8c3636c3c 100644 --- a/test/lisp/image-tests.el +++ b/test/lisp/image-tests.el @@ -74,6 +74,19 @@ (should (listp (find-image '((:type png :file "newsticker/rss-feed.png" :ascent center))))) (should-not (find-image '((:type png :file "does-not-exist-foo-bar.png"))))) +(ert-deftest image-supported-file-p/built-in () + ;; (skip-unless (image-type-available-p 'pbm)) ; Always built-in + (skip-unless (display-images-p)) ; (except in nox builds). + (should (eq (image-supported-file-p "foo.pbm") 'pbm))) + +(ert-deftest image-supported-file-p/optional () + (if (image-type-available-p 'jpeg) + (should (eq (image-supported-file-p "foo.jpg") 'jpeg)) + (should-not (image-supported-file-p "foo.jpg")))) + +(ert-deftest image-supported-file-p/unsupported-returns-nil () + (should-not (image-supported-file-p "foo.some-unsupported-format"))) + (ert-deftest image-type-from-file-name () (with-suppressed-warnings ((obsolete image-type-from-file-name)) (should (eq (image-type-from-file-name "foo.jpg") 'jpeg)) diff --git a/test/lisp/mail/ietf-drums-date-tests.el b/test/lisp/mail/ietf-drums-date-tests.el index 5b798077ff9..781d72d3529 100644 --- a/test/lisp/mail/ietf-drums-date-tests.el +++ b/test/lisp/mail/ietf-drums-date-tests.el @@ -52,52 +52,34 @@ ;; Start with some compatible RFC822 dates. (dolist (case '(("Mon, 22 Feb 2016 19:35:42 +0100" - (42 35 19 22 2 2016 1 -1 3600) - (22219 21758)) + (42 35 19 22 2 2016 1 -1 3600)) ("22 Feb 2016 19:35:42 +0100" - (42 35 19 22 2 2016 nil -1 3600) - (22219 21758)) + (42 35 19 22 2 2016 nil -1 3600)) ("Mon, 22 February 2016 19:35:42 +0100" - (42 35 19 22 2 2016 1 -1 3600) - (22219 21758)) + (42 35 19 22 2 2016 1 -1 3600)) ("Mon, 22 feb 2016 19:35:42 +0100" - (42 35 19 22 2 2016 1 -1 3600) - (22219 21758)) + (42 35 19 22 2 2016 1 -1 3600)) ("Monday, 22 february 2016 19:35:42 +0100" - (42 35 19 22 2 2016 1 -1 3600) - (22219 21758)) + (42 35 19 22 2 2016 1 -1 3600)) ("Monday, 22 february 2016 19:35:42 PST" - (42 35 19 22 2 2016 1 nil -28800) - (22219 54158)) + (42 35 19 22 2 2016 1 nil -28800)) ("Friday, 21 Sep 2018 13:47:58 PDT" - (58 47 13 21 9 2018 5 t -25200) - (23461 22782)) + (58 47 13 21 9 2018 5 t -25200)) ("Friday, 21 Sep 2018 13:47:58 EDT" - (58 47 13 21 9 2018 5 t -14400) - (23461 11982)))) + (58 47 13 21 9 2018 5 t -14400)) + ("Mon, 22 Feb 2016 19:35:42" + (42 35 19 22 2 2016 1 -1 nil)) + ("Friday, 21 Sep 2018 13:47:58" + (58 47 13 21 9 2018 5 -1 nil)))) (let* ((input (car case)) - (parsed (cadr case)) - (encoded (caddr case))) + (parsed (cadr case))) ;; The input should parse the same without RFC822. (should (equal (ietf-drums-parse-date-string input) parsed)) (should (equal (ietf-drums-parse-date-string input nil t) parsed)) ;; Check the encoded date (the official output, though the ;; decoded-time is easier to debug). - (should (equal (ietf-drums-parse-date input) encoded)))) - - ;; Test a few without timezones. - (dolist (case '(("Mon, 22 Feb 2016 19:35:42" - (42 35 19 22 2 2016 1 -1 nil)) - ("Friday, 21 Sep 2018 13:47:58" - (58 47 13 21 9 2018 5 -1 nil)))) - (let* ((input (car case)) - (parsed (cadr case))) - ;; The input should parse the same without RFC822. - (should (equal (ietf-drums-parse-date-string input) parsed)) - (should (equal (ietf-drums-parse-date-string input nil t) parsed)) - ;; We can't check the encoded date here because it will differ - ;; depending on the TZ of the test environment. - )) + (should (time-equal-p (ietf-drums-parse-date input) + (encode-time parsed))))) ;; Two-digit years are not allowed by the "modern" format. (should (equal (ietf-drums-parse-date-string "22 Feb 16 19:35:42 +0100") diff --git a/test/lisp/mail/undigest-tests.el b/test/lisp/mail/undigest-tests.el index 5ad0da0fc09..b88868be7fb 100644 --- a/test/lisp/mail/undigest-tests.el +++ b/test/lisp/mail/undigest-tests.el @@ -271,59 +271,65 @@ The footer. (ert-deftest rmail-undigest-test-rfc934-digest () "Test that we can undigest a RFC 934 digest." (let ((file (make-temp-file "undigest-test-"))) - (with-temp-file file - (insert rmail-rfc934-digest) - (write-region nil nil file) - (rmail file) - (undigestify-rmail-message) - (should (= rmail-total-messages 4)) - (should (string= (rmail-message-content 2) "Testing the undigester.\n\n")) - (should (string= (rmail-message-content 3) "This is message one.\n\n")) - (should (string= (rmail-message-content 4) "This is message two.\n"))))) + (unwind-protect + (with-temp-buffer + (insert rmail-rfc934-digest) + (write-region nil nil file) + (rmail file) + (undigestify-rmail-message) + (should (= rmail-total-messages 4)) + (should (string= (rmail-message-content 2) "Testing the undigester.\n\n")) + (should (string= (rmail-message-content 3) "This is message one.\n\n")) + (should (string= (rmail-message-content 4) "This is message two.\n"))) + (delete-file file)))) (ert-deftest rmail-undigest-test-rfc1153-digest-strict () "Test that we can undigest a strict RFC 1153 digest." :expected-result :failed (let ((file (make-temp-file "undigest-test-"))) - (with-temp-file file - (insert rmail-rfc1153-digest-strict) - (write-region nil nil file) - (rmail file) - (should - (condition-case nil - (progn + (unwind-protect + (with-temp-buffer + (insert rmail-rfc1153-digest-strict) + (write-region nil nil file) + (rmail file) + (should + (ignore-errors ;; This throws an error, because the Trailer is not recognized ;; as a valid RFC 822 (or later) message. (undigestify-rmail-message) (should (string= (rmail-message-content 2) "Testing the undigester.\n\n")) (should (string= (rmail-message-content 3) "This is message one.\n\n")) (should (string= (rmail-message-content 4) "This is message two.\n")) - t) - (error nil)))))) + t))) + (delete-file file)))) (ert-deftest rmail-undigest-test-rfc1153-less-strict-digest () "Test that we can undigest a RFC 1153 with a Subject header in its footer." (let ((file (make-temp-file "undigest-test-"))) - (with-temp-file file - (insert rmail-rfc1153-digest-less-strict) - (write-region nil nil file) - (rmail file) - (undigestify-rmail-message) - (should (= rmail-total-messages 5)) - (should (string= (rmail-message-content 3) "This is message one.\n\n")) - (should (string= (rmail-message-content 4) "This is message two.\n\n"))))) + (unwind-protect + (with-temp-buffer + (insert rmail-rfc1153-digest-less-strict) + (write-region nil nil file) + (rmail file) + (undigestify-rmail-message) + (should (= rmail-total-messages 5)) + (should (string= (rmail-message-content 3) "This is message one.\n\n")) + (should (string= (rmail-message-content 4) "This is message two.\n\n"))) + (delete-file file)))) (ert-deftest rmail-undigest-test-rfc1153-sloppy-digest () "Test that we can undigest a sloppy RFC 1153 digest." (let ((file (make-temp-file "undigest-test-"))) - (with-temp-file file - (insert rmail-rfc1153-digest-sloppy) - (write-region nil nil file) - (rmail file) - (undigestify-rmail-message) - (should (= rmail-total-messages 5)) - (should (string= (rmail-message-content 3) "This is message one.\n\n")) - (should (string= (rmail-message-content 4) "This is message two.\n\n"))))) + (unwind-protect + (with-temp-buffer + (insert rmail-rfc1153-digest-sloppy) + (write-region nil nil file) + (rmail file) + (undigestify-rmail-message) + (should (= rmail-total-messages 5)) + (should (string= (rmail-message-content 3) "This is message one.\n\n")) + (should (string= (rmail-message-content 4) "This is message two.\n\n"))) + (delete-file file)))) ;; This fails because `rmail-digest-parse-mime' combines the preamble with the ;; first message of the digest. And then, it doesn't get rid of the last @@ -332,23 +338,27 @@ The footer. "Test that we can undigest a RFC 1521 MIME digest." :expected-result :failed (let ((file (make-temp-file "undigest-test-"))) - (with-temp-file file - (insert rmail-rfc1521-mime-digest) - (write-region nil nil file) - (rmail file) - (undigestify-rmail-message) - (should (= rmail-total-messages 3)) - (should (string= (rmail-message-content 2) "Message one.\n\n")) - (should (string= (rmail-message-content 3) "Message two.\n\n"))))) + (unwind-protect + (with-temp-buffer + (insert rmail-rfc1521-mime-digest) + (write-region nil nil file) + (rmail file) + (undigestify-rmail-message) + (should (= rmail-total-messages 3)) + (should (string= (rmail-message-content 2) "Message one.\n\n")) + (should (string= (rmail-message-content 3) "Message two.\n\n"))) + (delete-file file)))) (ert-deftest rmail-undigest-test-multipart-mixed-digest () "Test that we can undigest a digest inside a multipart/mixed digest." (let ((file (make-temp-file "undigest-test-"))) - (with-temp-file file - (insert rmail-multipart-mixed-digest) - (write-region nil nil file) - (rmail file) - (undigestify-rmail-message) - (should (= rmail-total-messages 4)) - (should (string= (rmail-message-content 2) "Message one.\n\n")) - (should (string= (rmail-message-content 3) "Message two.\n\n"))))) + (unwind-protect + (with-temp-buffer + (insert rmail-multipart-mixed-digest) + (write-region nil nil file) + (rmail file) + (undigestify-rmail-message) + (should (= rmail-total-messages 4)) + (should (string= (rmail-message-content 2) "Message one.\n\n")) + (should (string= (rmail-message-content 3) "Message two.\n\n"))) + (delete-file file)))) diff --git a/test/lisp/mh-e/mh-thread-tests.el b/test/lisp/mh-e/mh-thread-tests.el index 84f59e5d300..ea8d441e2d1 100644 --- a/test/lisp/mh-e/mh-thread-tests.el +++ b/test/lisp/mh-e/mh-thread-tests.el @@ -24,7 +24,7 @@ (eval-when-compile (require 'cl-lib)) (defun mh-thread-tests-before-from () - "Generate the fields of a scan line up to where the 'From' field would start. + "Generate the fields of a scan line up to where the \"From\" field would start. The exact contents are not important, but the number of characters is." (concat (make-string mh-cmd-note ?9) (make-string mh-scan-cmd-note-width ?A) diff --git a/test/lisp/mouse-tests.el b/test/lisp/mouse-tests.el index 1be32006a10..03ecbc19858 100644 --- a/test/lisp/mouse-tests.el +++ b/test/lisp/mouse-tests.el @@ -25,6 +25,20 @@ ;;; Code: +(ert-deftest mouse-test-mouse-double-click-time () + (let ((double-click-time 500)) + (should (= (mouse-double-click-time) 500))) + (let ((double-click-time 0)) + (should (= (mouse-double-click-time) 0))) + (let ((double-click-time -500)) + (should (= (mouse-double-click-time) 0))) + (let ((double-click-time nil)) + (should (= (mouse-double-click-time) 0))) + (let ((double-click-time t)) + (should (numberp (mouse-double-click-time)))) + (let ((double-click-time '(invalid))) + (should (= (mouse-double-click-time) 0)))) + (ert-deftest bug23288-use-return-value () "If `mouse-on-link-p' returns a string, its first character is used." (cl-letf ((unread-command-events '((down-mouse-1 nil 1) (mouse-1 nil 1))) diff --git a/test/lisp/net/tramp-archive-tests.el b/test/lisp/net/tramp-archive-tests.el index 254595d1b4f..54d1ecf3652 100644 --- a/test/lisp/net/tramp-archive-tests.el +++ b/test/lisp/net/tramp-archive-tests.el @@ -888,7 +888,7 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'." (zerop (nth 1 fsi)) (zerop (nth 2 fsi)))))) -(ert-deftest tramp-archive-test46-auto-load () +(ert-deftest tramp-archive-test47-auto-load () "Check that `tramp-archive' autoloads properly." :tags '(:expensive-test) (skip-unless tramp-archive-enabled) @@ -905,30 +905,33 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'." (file-attributes %S \"/\")) \ (message \"tramp-archive loaded: %%s\" \ (featurep 'tramp-archive))))")) - (dolist (default-directory - `(,temporary-file-directory - ;; Starting Emacs in a directory which has - ;; `tramp-archive-file-name-regexp' syntax is - ;; supported only with Emacs > 27.2 (sigh!). - ;; (Bug#48476) - ,(file-name-as-directory tramp-archive-test-directory))) - (dolist (file `("/mock::foo" ,(concat tramp-archive-test-archive "foo"))) - (should - (string-match - (format - "tramp-archive loaded: %s[[:ascii:]]+tramp-archive loaded: %s" - (tramp-archive-file-name-p default-directory) - (or (tramp-archive-file-name-p default-directory) - (tramp-archive-file-name-p file))) - (shell-command-to-string - (format - "%s -batch -Q -L %s --eval %s" - (shell-quote-argument - (expand-file-name invocation-name invocation-directory)) - (mapconcat #'shell-quote-argument load-path " -L ") - (shell-quote-argument (format code file)))))))))) - -(ert-deftest tramp-archive-test46-delay-load () + (dolist (enabled '(t nil)) + (dolist (default-directory + `(,temporary-file-directory + ;; Starting Emacs in a directory which has + ;; `tramp-archive-file-name-regexp' syntax is + ;; supported only with Emacs > 27.2 (sigh!). + ;; (Bug#48476) + ,(file-name-as-directory tramp-archive-test-directory))) + (dolist (file `("/mock::foo" ,(concat tramp-archive-test-archive "foo"))) + (should + (string-match + (format + "tramp-archive loaded: %s[[:ascii:]]+tramp-archive loaded: %s" + (tramp-archive-file-name-p default-directory) + (or (tramp-archive-file-name-p default-directory) + (and enabled (tramp-archive-file-name-p file)))) + (shell-command-to-string + (format + "%s -batch -Q -L %s --eval %s --eval %s" + (shell-quote-argument + (expand-file-name invocation-name invocation-directory)) + (mapconcat #'shell-quote-argument load-path " -L ") + (shell-quote-argument + (format "(setq tramp-archive-enabled %s)" enabled)) + (shell-quote-argument (format code file))))))))))) + +(ert-deftest tramp-archive-test47-delay-load () "Check that `tramp-archive' is loaded lazily, only when needed." :tags '(:expensive-test) (skip-unless tramp-archive-enabled) diff --git a/test/lisp/net/tramp-resources/foo.tar.gz b/test/lisp/net/tramp-resources/foo.tar.gz Binary files differnew file mode 100644 index 00000000000..0d2e9878dd7 --- /dev/null +++ b/test/lisp/net/tramp-resources/foo.tar.gz diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index e9ea758956a..2d2bef732e0 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -47,6 +47,7 @@ (require 'ert) (require 'ert-x) (require 'seq) ; For `seq-random-elt', autoloaded since Emacs 28.1 +(require 'tar-mode) (require 'trace) (require 'tramp) (require 'vc) @@ -125,6 +126,7 @@ tramp-allow-unsafe-temporary-files t tramp-cache-read-persistent-data t ;; For auth-sources. tramp-copy-size-limit nil + tramp-error-show-message-timeout nil tramp-persistency-file-name nil tramp-verbose 0) @@ -2510,6 +2512,48 @@ This checks also `file-name-as-directory', `file-name-directory', (ignore-errors (advice-remove 'write-region advice)) (ignore-errors (delete-file tmp-name))))) +;; The following test is inspired by Bug#55166. +(ert-deftest tramp-test10-write-region-other-file-name-handler () + "Check that another file name handler in VISIT is acknowledged." + (skip-unless (tramp--test-enabled)) + (skip-unless (not (tramp--test-ange-ftp-p))) + (skip-unless (executable-find "gzip")) + + (let* ((default-directory tramp-test-temporary-file-directory) + (archive (ert-resource-file "foo.tar.gz")) + (tmp-file (expand-file-name (file-name-nondirectory archive))) + (require-final-newline t) + (inhibit-message t) + (backup-inhibited t) + create-lockfiles buffer1 buffer2) + (unwind-protect + (progn + (copy-file archive tmp-file 'ok) + ;; Read archive. Check contents of foo.txt, and modify it. Save. + (with-current-buffer (setq buffer1 (find-file-noselect tmp-file)) + (should (tar-goto-file "foo.txt")) + (save-current-buffer + (setq buffer2 (tar-extract)) + (should (string-equal (buffer-string) "foo\n")) + (goto-char (point-max)) + (insert "bar") + (should (null (save-buffer)))) + (should (null (save-buffer)))) + + (kill-buffer buffer1) + (kill-buffer buffer2) + ;; Read archive. Check contents of modified foo.txt. + (with-current-buffer (setq buffer1 (find-file-noselect tmp-file)) + (should (tar-goto-file "foo.txt")) + (save-current-buffer + (setq buffer2 (tar-extract)) + (should (string-equal (buffer-string) "foo\nbar\n"))))) + + ;; Cleanup. + (ignore-errors (kill-buffer buffer1)) + (ignore-errors (kill-buffer buffer2)) + (ignore-errors (delete-file tmp-file))))) + (ert-deftest tramp-test11-copy-file () "Check `copy-file'." (skip-unless (tramp--test-enabled)) @@ -4983,10 +5027,8 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." (ert-deftest tramp-test31-interrupt-process () "Check `interrupt-process'." - :tags (append '(:expensive-test :tramp-asynchronous-processes) - ;; The final `process-live-p' check does not run sufficiently. - (and (or (getenv "EMACS_HYDRA_CI") (getenv "EMACS_EMBA_CI")) - '(:unstable))) + ;; The final `process-live-p' check does not run sufficiently. + :tags '(:expensive-test :tramp-asynchronous-processes :unstable) (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-sh-p)) (skip-unless (not (tramp--test-crypt-p))) @@ -5025,10 +5067,8 @@ If UNSTABLE is non-nil, the test is tagged as `:unstable'." (ert-deftest tramp-test31-signal-process () "Check `signal-process'." - :tags (append '(:expensive-test :tramp-asynchronous-processes) - ;; The final `process-live-p' check does not run sufficiently. - (and (or (getenv "EMACS_HYDRA_CI") (getenv "EMACS_EMBA_CI")) - '(:unstable))) + ;; The final `process-live-p' check does not run sufficiently. + :tags '(:expensive-test :tramp-asynchronous-processes :unstable) (skip-unless (tramp--test-enabled)) (skip-unless (tramp--test-sh-p)) (skip-unless (not (tramp--test-crypt-p))) @@ -7301,8 +7341,67 @@ process sentinels. They shall not disturb each other." (delete-directory tmp-name) (delete-file (concat tmp-name ".tar.gz")))) +(ert-deftest tramp-test46-read-password () + "Check Tramp password handling." + :tags '(:expensive-test) + (skip-unless (tramp--test-enabled)) + (skip-unless (tramp--test-mock-p)) + ;; Not all read commands understand argument "-s" or "-p". + (skip-unless + (string-empty-p + (let ((shell-file-name "sh")) + (shell-command-to-string "read -s -p Password: pass")))) + + (let ((pass "secret") + (mock-entry (copy-sequence (assoc "mock" tramp-methods))) + mocked-input tramp-methods) + ;; We must mock `read-string', in order to avoid interactive + ;; arguments. + (cl-letf* (((symbol-function #'read-string) + (lambda (&rest _args) (pop mocked-input)))) + (setcdr + (assq 'tramp-login-args mock-entry) + `((("-c") + (,(tramp-shell-quote-argument + (concat + "read -s -p 'Password: ' pass; echo; " + "(test \"pass$pass\" != \"pass" pass "\" && " + "echo \"Login incorrect\" || sh -i)")))))) + (setq tramp-methods `(,mock-entry)) + + ;; Reading password from stdin works. + (tramp-cleanup-connection tramp-test-vec 'keep-debug) + ;; We don't want to invalidate the password. + (setq mocked-input `(,(copy-sequence pass))) + (should (file-exists-p tramp-test-temporary-file-directory)) + + ;; Don't entering a password returns in error. + (tramp-cleanup-connection tramp-test-vec 'keep-debug) + (setq mocked-input nil) + (should-error (file-exists-p tramp-test-temporary-file-directory)) + + ;; A wrong password doesn't work either. + (tramp-cleanup-connection tramp-test-vec 'keep-debug) + (setq mocked-input `(,(concat pass pass))) + (should-error (file-exists-p tramp-test-temporary-file-directory)) + + ;; Reading password from auth-source works. We use the netrc + ;; backend; the other backends shall behave similar. + ;; Macro `ert-with-temp-file' was introduced in Emacs 29.1. + (with-no-warnings (when (symbol-plist 'ert-with-temp-file) + (tramp-cleanup-connection tramp-test-vec 'keep-debug) + (setq mocked-input nil) + (auth-source-forget-all-cached) + (ert-with-temp-file netrc-file + :prefix "tramp-test" :suffix "" + :text (format + "machine %s port mock password %s" + (file-remote-p tramp-test-temporary-file-directory 'host) pass) + (let ((auth-sources `(,netrc-file))) + (should (file-exists-p tramp-test-temporary-file-directory))))))))) + ;; This test is inspired by Bug#29163. -(ert-deftest tramp-test46-auto-load () +(ert-deftest tramp-test47-auto-load () "Check that Tramp autoloads properly." ;; If we use another syntax but `default', Tramp is already loaded ;; due to the `tramp-change-syntax' call. @@ -7327,7 +7426,7 @@ process sentinels. They shall not disturb each other." (mapconcat #'shell-quote-argument load-path " -L ") (shell-quote-argument code))))))) -(ert-deftest tramp-test46-delay-load () +(ert-deftest tramp-test47-delay-load () "Check that Tramp is loaded lazily, only when needed." ;; Tramp is neither loaded at Emacs startup, nor when completing a ;; non-Tramp file name like "/foo". Completing a Tramp-alike file @@ -7356,7 +7455,7 @@ process sentinels. They shall not disturb each other." (mapconcat #'shell-quote-argument load-path " -L ") (shell-quote-argument (format code tm))))))))) -(ert-deftest tramp-test46-recursive-load () +(ert-deftest tramp-test47-recursive-load () "Check that Tramp does not fail due to recursive load." (skip-unless (tramp--test-enabled)) @@ -7380,7 +7479,7 @@ process sentinels. They shall not disturb each other." (mapconcat #'shell-quote-argument load-path " -L ") (shell-quote-argument code)))))))) -(ert-deftest tramp-test46-remote-load-path () +(ert-deftest tramp-test47-remote-load-path () "Check that Tramp autoloads its packages with remote `load-path'." ;; `tramp-cleanup-all-connections' is autoloaded from tramp-cmds.el. ;; It shall still work, when a remote file name is in the @@ -7405,7 +7504,7 @@ process sentinels. They shall not disturb each other." (mapconcat #'shell-quote-argument load-path " -L ") (shell-quote-argument code))))))) -(ert-deftest tramp-test47-unload () +(ert-deftest tramp-test48-unload () "Check that Tramp and its subpackages unload completely. Since it unloads Tramp, it shall be the last test to run." :tags '(:expensive-test) @@ -7503,8 +7602,9 @@ If INTERACTIVE is non-nil, the tests are run interactively." ;; * Work on skipped tests. Make a comment, when it is impossible. ;; * Revisit expensive tests, once problems in `tramp-error' are solved. ;; * Fix `tramp-test06-directory-file-name' for "ftp". -;; * Implement `tramp-test31-interrupt-process' for "adb", "sshfs" and -;; for direct async processes. +;; * Implement `tramp-test31-interrupt-process' and +;; `tramp-test31-signal-process' for "adb", "sshfs" and for direct +;; async processes. Check, why they don't run stable. ;; * Check, why direct async processes do not work for ;; `tramp-test44-asynchronous-requests'. diff --git a/test/lisp/progmodes/cperl-mode-tests.el b/test/lisp/progmodes/cperl-mode-tests.el index b8a3bd97d8d..4e0debffb69 100644 --- a/test/lisp/progmodes/cperl-mode-tests.el +++ b/test/lisp/progmodes/cperl-mode-tests.el @@ -64,7 +64,7 @@ The expected output from running BODY on the input goes here. # -------- NAME: end -------- You can have many of these blocks in one test file. You can -chose a NAME for each block, which is passed to the 'should' +chose a NAME for each block, which is passed to the `should' clause for easy identification of the first test case that failed (if any). Text outside these the blocks is ignored by the tests, so you can use it to document the test cases if you wish." diff --git a/test/lisp/progmodes/python-tests.el b/test/lisp/progmodes/python-tests.el index 1a6a7dc176d..01b233cc425 100644 --- a/test/lisp/progmodes/python-tests.el +++ b/test/lisp/progmodes/python-tests.el @@ -3503,10 +3503,7 @@ def foo(): (should (string= (python-shell-buffer-substring (python-tests-look-at "print ('a')") (point-max)) - "if True: - - print ('a') -")))) + "# -*- coding: utf-8 -*-\nif True:\n print ('a')\n\n")))) (ert-deftest python-shell-buffer-substring-11 () "Check substring from partial block and point within indentation." @@ -3521,10 +3518,7 @@ def foo(): (backward-char 1) (point)) (point-max)) - "if True: - - print ('a') -")))) + "# -*- coding: utf-8 -*-\nif True:\n print ('a')\n\n")))) (ert-deftest python-shell-buffer-substring-12 () "Check substring from partial block and point in whitespace." @@ -3539,13 +3533,7 @@ def foo(): (should (string= (python-shell-buffer-substring (python-tests-look-at "# Whitespace") (point-max)) - "if True: - - - # Whitespace - - print ('a') -")))) + "# -*- coding: utf-8 -*-\n\nif True:\n # Whitespace\n\n print ('a')\n\n")))) diff --git a/test/lisp/progmodes/ruby-mode-resources/ruby.rb b/test/lisp/progmodes/ruby-mode-resources/ruby.rb index f31cea86a54..0c206b1e0c2 100644 --- a/test/lisp/progmodes/ruby-mode-resources/ruby.rb +++ b/test/lisp/progmodes/ruby-mode-resources/ruby.rb @@ -491,3 +491,12 @@ in ['th', orig_text, 'en', trans_text] in {'th' => orig_text, 'ja' => trans_text} puts "Japanese translation: #{orig_text} => #{trans_text}" end + +# Tokenizing "**" and "|" separately. +def resolve(**args) + members = proc do |**args| + p(**args) + end + + member.call(**args) +end diff --git a/test/lisp/progmodes/sql-tests.el b/test/lisp/progmodes/sql-tests.el index 7e36d845e2c..c644d115df6 100644 --- a/test/lisp/progmodes/sql-tests.el +++ b/test/lisp/progmodes/sql-tests.el @@ -425,5 +425,85 @@ The ACTION will be tested after set-up of PRODUCT." (let ((sql-password "password")) (should (equal "password" (sql-comint-automatic-password ""))))) + + +;; Tests for sql-interactive-remove-continuation-prompt + +(defmacro sql-tests-remove-cont-prompts-harness (&rest body) + "Set-up and tear-down for tests of +`sql-interactive-remove-continuation-prompt'." + (declare (indent 0)) + `(let ((comint-prompt-regexp "^ +\\.\\{3\\} ") + (sql-output-newline-count nil) + (sql-preoutput-hold nil)) + ,@body + (should (null sql-output-newline-count)) + (should (null sql-preoutput-hold)))) + +(ert-deftest sql-tests-remove-cont-prompts-pass-through () + "Test that `sql-interactive-remove-continuation-prompt' just +passes the output line through when it doesn't expect prompts." + (sql-tests-remove-cont-prompts-harness + (should + (equal " ... " + (sql-interactive-remove-continuation-prompt + " ... "))))) + +(ert-deftest sql-tests-remove-cont-prompts-anchored-successive () + "Test that `sql-interactive-remove-continuation-prompt' is able +to delete multiple prompts (anchored to bol) even if they appear +in a single line, but not more than `sql-output-newline-count'." + (sql-tests-remove-cont-prompts-harness + (setq sql-output-newline-count 2) + (should + (equal + ;; 2 of 3 prompts are deleted + "some output ... more output...\n\ + ... \n\ +output after prompt" + (sql-interactive-remove-continuation-prompt + "some output ... more output...\n\ + ... ... ... \n\ +output after prompt"))))) + +(ert-deftest sql-tests-remove-cont-prompts-collect-chunked-output () + "Test that `sql-interactive-remove-continuation-prompt' properly +collects output when output arrives in chunks, with prompts +intermixed." + (sql-tests-remove-cont-prompts-harness + (setq sql-output-newline-count 2) + + ;; Part of first prompt gets held. Complete line is passed + ;; through. + (should (equal "line1\n" + (sql-interactive-remove-continuation-prompt + "line1\n .."))) + (should (equal " .." sql-preoutput-hold)) + (should (equal 2 sql-output-newline-count)) + + ;; First prompt is complete - remove it. Hold part of line2. + (should (equal "" + (sql-interactive-remove-continuation-prompt ". li"))) + (should (equal "li" sql-preoutput-hold)) + (should (equal 1 sql-output-newline-count)) + + ;; Remove second prompt. Flush output & don't hold / process any + ;; output further on. + (should (equal "line2\nli" + (sql-interactive-remove-continuation-prompt "ne2\n ... li"))) + (should (null sql-preoutput-hold)) + (should (null sql-output-newline-count)) + (should (equal "line3\n ... " + (sql-interactive-remove-continuation-prompt "line3\n ... "))))) + +(ert-deftest sql-tests-remove-cont-prompts-flush-held () + "Test that when we don't wait for prompts, + `sql-interactive-remove-continuation-prompt' just 'flushes' held + output, with no prompt processing." + (sql-tests-remove-cont-prompts-harness + (setq sql-preoutput-hold "line1\n ..") + (should (equal "line1\n ... line2 .." + (sql-interactive-remove-continuation-prompt ". line2 .."))))) + (provide 'sql-tests) ;;; sql-tests.el ends here diff --git a/test/lisp/replace-tests.el b/test/lisp/replace-tests.el index 364e1f8b1de..ef1e5c3eafc 100644 --- a/test/lisp/replace-tests.el +++ b/test/lisp/replace-tests.el @@ -416,6 +416,7 @@ Each element has the format: ;; Empty inputs ("aaa" "M-% a RET RET !" "") ("aaa" "M-% RET 1 RET !" "1a1a1a") + ("aaa" "M-% RET RET !" "aaa") ;; Reuse the previous default ("aaa" "M-% a RET 1 RET . M-% RET !" "111") @@ -424,16 +425,21 @@ Each element has the format: ;; Empty inputs ("aaa" "C-M-% a* RET RET !" "") ("aaa" "C-M-% RET 1 RET !" "1a1a1a") + ("aaa" "C-M-% RET RET !" "aaa") ;; Empty matches ("aaa" "C-M-% b* RET 1 RET !" "1a1a1a") ;; Complete matches ("aaa" "C-M-% .* RET 1 RET !" "1") - ;; Adjacent matches + ;; Adjacent non-empty matches ("abaab" "C-M-% ab* RET 12 RET !" "121212") - + ;; Adjacent non-empty and empty matches + ("abab" "C-M-% a* RET 1 RET !" "1b1b") + ("abab" "C-M-% b* RET 1 RET !" "1a1a1") + ;; Test case from commit 5632eb272c7 + ("a a a " "C-M-% \\ba SPC RET c RET !" "ccc") ; not "ca c" )) -(defun query-replace--perform-tests (tests) +(defun query-replace--run-tests (tests) (with-temp-buffer (save-window-excursion ;; `execute-kbd-macro' is applied to window only @@ -448,11 +454,11 @@ Each element has the format: (should (equal (buffer-string) (nth 2 case))))))) (ert-deftest query-replace-tests () - (query-replace--perform-tests query-replace-tests)) + (query-replace--run-tests query-replace-tests)) (ert-deftest query-replace-search-function-tests () (let* ((replace-re-search-function #'re-search-forward)) - (query-replace--perform-tests query-replace-tests)) + (query-replace--run-tests query-replace-tests)) (let* ((pairs '((1 . 2) (3 . 4))) (replace-re-search-function @@ -469,7 +475,31 @@ Each element has the format: ;; FIXME: this test should pass after fixing bug#54733: ;; ("aaaa" "C-M-% .* RET 1 RET !" "1a1a") ))) - (query-replace--perform-tests tests))) + (query-replace--run-tests tests))) + + +;;; General tests for `perform-replace'. + +(defconst perform-replace-tests + '( + ;; Test case from commit 5632eb272c7 + ("a a a " "\\ba " "c" nil t nil nil nil nil nil nil nil "ccc") ; not "ca c" + ;; The same with region inside the second match + ;; FIXME: this test should pass after fixing bug#54733: + ;; ("a a a " "\\ba " "c" nil t nil nil nil 1 4 nil nil "ca a ") + )) + +(defun perform-replace--run-tests (tests) + (with-temp-buffer + (dolist (case tests) + (delete-region (point-min) (point-max)) + (insert (pop case)) + (goto-char (point-min)) + (apply 'perform-replace (butlast case)) + (should (equal (buffer-string) (car (last case))))))) + +(ert-deftest perform-replace-tests () + (perform-replace--run-tests perform-replace-tests)) ;;; Tests for `query-replace' undo feature. diff --git a/test/lisp/simple-tests.el b/test/lisp/simple-tests.el index 6350bebeeea..dcab811bb5a 100644 --- a/test/lisp/simple-tests.el +++ b/test/lisp/simple-tests.el @@ -966,8 +966,8 @@ See Bug#21722." (setq buffer-undo-list nil) (downcase-word 1) (should (= (length (delq nil (undo-make-selective-list 1 9))) 2)) - (should (= (length (delq nil (undo-make-selective-list 4 9))) 1)) - ;; FIXME this is the off-by-one error case. + ;; FIXME: These should give 0, but currently give 1. + ;;(should (= (length (delq nil (undo-make-selective-list 4 9))) 0)) ;;(should (= (length (delq nil (undo-make-selective-list 5 9))) 0)) (should (= (length (delq nil (undo-make-selective-list 6 9))) 0)))) diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index e027c68d0b2..3725f180f3a 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -1028,5 +1028,35 @@ final or penultimate step during initialization.")) (should (readablep "foo")) (should-not (readablep (list (make-marker))))) +(ert-deftest test-string-lines () + (should (equal (string-lines "") '(""))) + (should (equal (string-lines "" t) '())) + + (should (equal (string-lines "foo") '("foo"))) + (should (equal (string-lines "foo\n") '("foo"))) + (should (equal (string-lines "foo\nbar") '("foo" "bar"))) + + (should (equal (string-lines "foo" t) '("foo"))) + (should (equal (string-lines "foo\n" t) '("foo"))) + (should (equal (string-lines "foo\nbar" t) '("foo" "bar"))) + (should (equal (string-lines "foo\n\n\nbar" t) '("foo" "bar"))) + + (should (equal (string-lines "foo" nil t) '("foo"))) + (should (equal (string-lines "foo\n" nil t) '("foo\n"))) + (should (equal (string-lines "foo\nbar" nil t) '("foo\n" "bar"))) + (should (equal (string-lines "foo\n\n\nbar" nil t) + '("foo\n" "\n" "\n" "bar"))) + + (should (equal (string-lines "foo" t t) '("foo"))) + (should (equal (string-lines "foo\n" t t) '("foo\n"))) + (should (equal (string-lines "foo\nbar" t t) '("foo\n" "bar"))) + (should (equal (string-lines "foo\n\n\nbar" t t) + '("foo\n" "bar")))) + +(ert-deftest test-keymap-parse-macros () + (should (equal (key-parse "C-x ( C-d C-x )") [24 40 4 24 41])) + (should (equal (kbd "C-x ( C-d C-x )") "")) + (should (equal (kbd "C-x ( C-x )") ""))) + (provide 'subr-tests) ;;; subr-tests.el ends here diff --git a/test/lisp/textmodes/page-tests.el b/test/lisp/textmodes/page-tests.el index 596f3a6ceb7..b7217e69f0c 100644 --- a/test/lisp/textmodes/page-tests.el +++ b/test/lisp/textmodes/page-tests.el @@ -80,6 +80,17 @@ (narrow-to-page 2) (should (equal (buffer-string) "baz")) (narrow-to-page -1) + (should (equal (buffer-string) "bar\n")) + + (widen) + (goto-char (point-min)) + (narrow-to-page) + (should (equal (buffer-string) "foo\n")) + (goto-char (point-max)) + (narrow-to-page 2) + (should (equal (buffer-string) "baz")) + (goto-char (point-max)) + (narrow-to-page -1) (should (equal (buffer-string) "bar\n")))) (ert-deftest page-tests-count-lines-page () @@ -100,4 +111,5 @@ (forward-page) (should (equal (page--what-page) '(3 4))))) + ;;; page-tests.el ends here diff --git a/test/lisp/xml-tests.el b/test/lisp/xml-tests.el index eecf6406fb8..748f1e39446 100644 --- a/test/lisp/xml-tests.el +++ b/test/lisp/xml-tests.el @@ -97,7 +97,7 @@ ((("FOOBAR:" . "something") nil "hi there")) ((FOOBAR:something nil "hi there")))) "List of strings which are parsed using namespace expansion. -Parser is called with and without 'symbol-qnames argument.") +Parser is called with and without `symbol-qnames' argument.") (ert-deftest xml-parse-tests () "Test XML parsing." diff --git a/test/src/regex-emacs-tests.el b/test/src/regex-emacs-tests.el index e6288d1fc9b..ff0d6be3f5d 100644 --- a/test/src/regex-emacs-tests.el +++ b/test/src/regex-emacs-tests.el @@ -157,8 +157,8 @@ are known failures, and are skipped." (defun regex-tests-compare (string what-failed bounds-ref &optional substring-ref) "I just ran a search, looking at STRING. WHAT-FAILED describes -what failed, if anything; valid values are 'search-failed, -'compilation-failed and nil. I compare the beginning/end of each +what failed, if anything; valid values are `search-failed', +`compilation-failed' and nil. I compare the beginning/end of each group with their expected values. This is done with either BOUNDS-REF or SUBSTRING-REF; one of those should be non-nil. BOUNDS-REF is a sequence [start-ref0 end-ref0 start-ref1 @@ -166,9 +166,9 @@ end-ref1 ....] while SUBSTRING-REF is the expected substring obtained by indexing the input string by start/end-ref. If the search was supposed to fail then start-ref0/substring-ref0 -is 'search-failed. If the search wasn't even supposed to compile +is `search-failed'. If the search wasn't even supposed to compile successfully, then start-ref0/substring-ref0 is -'compilation-failed. If I only care about a match succeeding, +`compilation-failed'. If I only care about a match succeeding, this can be set to t. This function returns a string that describes the failure, or nil @@ -259,8 +259,8 @@ BOUNDS-REF is a sequence [start-ref0 end-ref0 start-ref1 end-ref1 ....]. If the search was supposed to fail then start-ref0 is -'search-failed. If the search wasn't even supposed to compile -successfully, then start-ref0 is 'compilation-failed. +`search-failed'. If the search wasn't even supposed to compile +successfully, then start-ref0 is `compilation-failed'. This function returns a string that describes the failure, or nil on success" diff --git a/test/src/sqlite-tests.el b/test/src/sqlite-tests.el index 6e44300f3ad..5af43923012 100644 --- a/test/src/sqlite-tests.el +++ b/test/src/sqlite-tests.el @@ -216,4 +216,29 @@ db "/usr/lib/x86_64-linux-gnu/libsqlite3_mod_csvtable.so") '(nil t))))) +(ert-deftest sqlite-blob () + (skip-unless (sqlite-available-p)) + (let (db) + (progn + (setq db (sqlite-open)) + (sqlite-execute + db "create table if not exists test10 (col1 text, col2 blob, col3 numbre)") + (let ((string (with-temp-buffer + (set-buffer-multibyte nil) + (insert 0 1 2) + (buffer-string)))) + (should-not (multibyte-string-p string)) + (sqlite-execute + db "insert into test10 values (?, ?, 1)" + (list string + (propertize string + 'coding-system 'binary))) + (cl-destructuring-bind + (c1 c2 _) + (car (sqlite-select db "select * from test10 where col3 = 1")) + (should (equal c1 string)) + (should (equal c2 string)) + (should (multibyte-string-p c1)) + (should-not (multibyte-string-p c2))))))) + ;;; sqlite-tests.el ends here diff --git a/test/src/timefns-tests.el b/test/src/timefns-tests.el index 1b49e0622f5..08d06f27d9e 100644 --- a/test/src/timefns-tests.el +++ b/test/src/timefns-tests.el @@ -169,6 +169,10 @@ a fixed place on the right and are padded on the left." (ert-deftest time-equal-p-nil-nil () (should (time-equal-p nil nil))) +(ert-deftest time-equal-p-NaN-NaN () + (let ((x 0.0e+NaN)) + (should (not (time-equal-p x x))))) + (ert-deftest time-arith-tests () (let ((time-values (list 0 -1 1 0.0 -0.0 -1.0 1.0 most-negative-fixnum most-positive-fixnum @@ -221,6 +225,15 @@ a fixed place on the right and are padded on the left." (encode-time '(29 31 17 30 4 2019 2 t 7200)) '(23752 27217)))) +(ert-deftest encode-time-alternate-apis () + (let* ((time '(30 30 12 15 6 1970)) + (time-1 (append time '(nil -1 nil))) + (etime (encode-time time))) + (should (time-equal-p etime (encode-time time-1))) + (should (time-equal-p etime (apply #'encode-time time))) + (should (time-equal-p etime (apply #'encode-time time-1))) + (should (time-equal-p etime (apply #'encode-time (append time '(nil))))))) + (ert-deftest float-time-precision () (should (= (float-time '(0 1 0 4025)) 1.000000004025)) (should (= (float-time '(1000000004025 . 1000000000000)) 1.000000004025)) |