diff options
| author | Sean Whitton <spwhitton@spwhitton.name> | 2022-11-21 13:36:24 -0700 |
|---|---|---|
| committer | Sean Whitton <spwhitton@spwhitton.name> | 2022-11-21 13:36:24 -0700 |
| commit | 14be64cb03c71cc4da295f88efa71b153bd72fd8 (patch) | |
| tree | a8e264cb8834efa229426edeafd62b8bc7e0385b | |
| parent | 3b664e4cab40dd2f42dc4316bf7cc93bbbd487f1 (diff) | |
| parent | f176a36f4629b56c9fd9e3fc15aebd04a168c4f5 (diff) | |
| download | emacs-14be64cb03c71cc4da295f88efa71b153bd72fd8.tar.gz | |
Merge remote-tracking branch 'origin/master' into athena/unstable
357 files changed, 6200 insertions, 2538 deletions
diff --git a/.clang-format b/.clang-format index 464375bd418..2208240a669 100644 --- a/.clang-format +++ b/.clang-format @@ -1,15 +1,18 @@ Language: Cpp BasedOnStyle: GNU AlignEscapedNewlinesLeft: true +AlignOperands: Align AlwaysBreakAfterReturnType: TopLevelDefinitions BreakBeforeBinaryOperators: All BreakBeforeBraces: GNU ColumnLimit: 70 ContinuationIndentWidth: 2 -ForEachMacros: [FOR_EACH_TAIL, - FOR_EACH_TAIL_SAFE, - FOR_EACH_LIVE_BUFFER, - ITREE_FOREACH] +ForEachMacros: + - FOR_EACH_TAIL + - FOR_EACH_TAIL_SAFE + - FOR_EACH_LIVE_BUFFER + - ITREE_FOREACH + - FOR_EACH_ALIST_VALUE IncludeCategories: - Regex: '^<config\.h>$' Priority: -1 @@ -19,6 +22,11 @@ IncludeCategories: Priority: 2 - Regex: '.*' Priority: 3 +WhitespaceSensitiveMacros: + - STR + - CALL1I + - CALL2I + - STR_VALUE KeepEmptyLinesAtTheStartOfBlocks: false MaxEmptyLinesToKeep: 1 PenaltyBreakBeforeFirstCallParameter: 2000 diff --git a/.dir-locals.el b/.dir-locals.el index f7c73031cc8..f0ab46236f3 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -7,9 +7,11 @@ (emacs-lisp-docstring-fill-column . 65) (vc-git-annotate-switches . "-w") (bug-reference-url-format . "https://debbugs.gnu.org/%s") - (diff-add-log-use-relative-names . t))) + (diff-add-log-use-relative-names . t) + (vc-prepare-patches-separately . nil))) (c-mode . ((c-file-style . "GNU") - (c-noise-macro-names . ("INLINE" "ATTRIBUTE_NO_SANITIZE_UNDEFINED" "UNINIT" "CALLBACK" "ALIGN_STACK")) + (c-noise-macro-names . ("INLINE" "NO_INLINE" "ATTRIBUTE_NO_SANITIZE_UNDEFINED" + "UNINIT" "CALLBACK" "ALIGN_STACK")) (electric-quote-comment . nil) (electric-quote-string . nil) (indent-tabs-mode . t) diff --git a/.gitignore b/.gitignore index 4a92414f1ad..9be3bfc4f3b 100644 --- a/.gitignore +++ b/.gitignore @@ -30,6 +30,7 @@ debian/emacs-snapshot/ # Personal customization. .dir-locals-2.el +.no-advice-on-failure # Built by 'autogen.sh'. /aclocal.m4 diff --git a/CONTRIBUTE b/CONTRIBUTE index 94d757daafe..c226645bd7c 100644 --- a/CONTRIBUTE +++ b/CONTRIBUTE @@ -202,9 +202,10 @@ them right the first time, so here are guidelines for formatting them: you can put a paragraph (after the empty line and before the individual ChangeLog entries) that further describes the commit. -- Limit lines in commit messages to 78 characters, unless they consist - of a single word of at most 140 characters; this is enforced by a - commit hook. +- Lines in ChangeLog entries should preferably be not longer than 63 + characters, and must not exceed 78 characters, unless they consist + of a single word of at most 140 characters; this 78/140 limit is + enforced by a commit hook. - If only a single file is changed, the summary line can be the normal file first line (starting with the asterisk). Then there is no diff --git a/ChangeLog.1 b/ChangeLog.1 index 35533d60fff..a8df1c04202 100644 --- a/ChangeLog.1 +++ b/ChangeLog.1 @@ -930,7 +930,7 @@ (mostlyclean_dirs, clean_dirs, distclean_dirs, maintainer_clean_dirs): New variables. (mostlyclean, clean, distclean, bootstrap-clean, maintainer-clean) - (extraclean): Define using each subdirectory as a prequisite. + (extraclean): Define using each subdirectory as a prerequisite. * lib/Makefile.am (bootstrap-clean): New. 2014-06-15 Paul Eggert <eggert@cs.ucla.edu> diff --git a/ChangeLog.2 b/ChangeLog.2 index 5a73d53b8bf..483dec25420 100644 --- a/ChangeLog.2 +++ b/ChangeLog.2 @@ -9317,7 +9317,7 @@ optional. * src/buffer.c (Fbarf_if_buffer_read_only): Rename argument POS - to POSITION to keep consisteny with doc-string. + to POSITION to keep consistent with doc-string. 2016-02-01 Paul Eggert <eggert@cs.ucla.edu> @@ -26343,7 +26343,7 @@ (verilog-type-font-keywords): Cycle delay operators like ##1 and ##[0:$] are now highlighted in their entirety similarly to the # delay-control operator. Likewise, the followed-by operators #-# - and #=# are no longer partially highlighed. + and #=# are no longer partially highlighted. (verilog-backward-syntactic-ws-quick) (verilog-skip-backward-comments): Minor performance improvements to buffer traversal functions for reduced latency. @@ -34464,7 +34464,7 @@ * lisp/emacs-lisp/package.el: Make archive and status pseudo-keywords (package--has-keyword-p): Understand "arc:xxxx" and "status:xxxx" - as special keywords which match agains package archive and status + as special keywords which match against package archive and status respectively. * etc/NEWS: Document it. diff --git a/ChangeLog.3 b/ChangeLog.3 index f2245a4ed53..d27a14d4279 100644 --- a/ChangeLog.3 +++ b/ChangeLog.3 @@ -4043,7 +4043,7 @@ * doc/emacs/maintaining.texi (Basic VC Editing): Mention Dired buffer. - * doc/emacs/text.texi (Outline Mode): Replace S-TAB with with S-<TAB>. + * doc/emacs/text.texi (Outline Mode): Replace S-TAB with S-<TAB>. * etc/NEWS: Add some missing +++/--- and move some related items closer. @@ -5557,7 +5557,7 @@ Fix ert errors when there's a test that binds `debug-on-error' * lisp/emacs-lisp/ert.el (ert--run-test-internal): Don't infloop - on errors when signalling errors (bug#51131). + on errors when signaling errors (bug#51131). 2021-10-10 Paul Eggert <eggert@cs.ucla.edu> @@ -5731,7 +5731,7 @@ 2021-10-09 Dmitry Gutov <dgutov@yandex.ru> - Slight simplificaiton + Slight simplification * lisp/progmodes/xref.el (xref--insert-xrefs): Compute log only once. Use 'dolist'. @@ -12670,7 +12670,7 @@ 2021-09-03 Lars Ingebrigtsen <larsi@gnus.org> - Fix `describe-function' for autoloaded adviced functions + Fix `describe-function' for autoloaded advised functions * lisp/emacs-lisp/nadvice.el (advice--make-single-doc): Factor out. @@ -20026,7 +20026,7 @@ Add query command removed in 4ff1f66b12 - * lisp/net/rcirc.el (query): Readd accidentally removed command + * lisp/net/rcirc.el (query): Re-add accidentally removed command. 2021-07-06 Philip Kaludercic <philipk@posteo.net> @@ -21063,7 +21063,7 @@ Fix prompting for large files when loading literally * lisp/files.el (find-file-noselect): Don't include "literally" in - the "large file" prompt if we're gonna load literally anyway + the "large file" prompt if we're going to load literally anyway (bug#49144). 2021-06-21 Lars Ingebrigtsen <larsi@gnus.org> @@ -21772,7 +21772,7 @@ EIEIO: Promote the CLOS behavior over the EIEIO-specific behavior - Change docs to advertize `slot-value` rather than `oref`. + Change docs to advertise `slot-value` rather than `oref`. Change the implementation of `:initform` to better match the CLOS semantics, while preserving the EIEIO semantics, but warn when encountering cases where the two diverge. @@ -21790,8 +21790,8 @@ * lisp/emacs-lisp/eieio.el (defclass): Warn about inapplicable `:initarg` and about uses of init forms that are ambiguous. - (oref): Don't advertize the deprecated use of initargs as slot names. - (oref-default): Don't advertize the deprecated case where it returns the + (oref): Don't advertise the deprecated use of initargs as slot names. + (oref-default): Don't advertise the deprecated case where it returns the initform's value. (initialize-instance): Use `macroexp-const-p`. * lisp/emacs-lisp/eieio-core.el (eieio--unbound): Rename from @@ -27204,7 +27204,7 @@ 2021-04-25 Andrea Corallo <akrl@sdf.org> - Merge branch 'feature/native-comp' into into trunk + Merge branch 'feature/native-comp' into trunk 2021-04-25 Lars Ingebrigtsen <larsi@gnus.org> @@ -34265,7 +34265,7 @@ Use `length=' and family where possible in native comp code * lisp/emacs-lisp/comp-cstr.el (comp-intersect-typesets) - (comp-cstr-imm): Use Use `length=' and family where possible. + (comp-cstr-imm): Use `length=' and family where possible. * lisp/emacs-lisp/comp.el (comp-add-cond-cstrs-target-block) (comp-compute-dominator-frontiers) (batch-byte-native-compile-for-bootstrap): Likewise. @@ -35728,7 +35728,7 @@ (comp-arithm-cmp-fun-p, comp-negate-arithm-cmp-fun) (comp-reverse-arithm-fun): Rename and add '=' '!='. (comp-emit-assume, comp-add-cond-cstrs, comp-fwprop-insn): Update - for new function nameing and to handle '='. + for new function naming and to handle '='. * lisp/emacs-lisp/comp-cstr.el (comp-cstr-=): New function. * test/src/comp-tests.el (comp-tests-type-spec-tests): Add a bunch of '=' specific tests. @@ -36674,7 +36674,7 @@ 2021-02-24 Andrea Corallo <akrl@sdf.org> - Fix async compilation and paramenter naming + Fix async compilation and parameter naming * lisp/emacs-lisp/comp.el (native--compile-async) (native-compile-async): Fix broken parameter renaming. @@ -39854,7 +39854,7 @@ * lisp/net/mairix.el: Use lexical-binding. Remove redundant `:group` args. - (mairix-widget-create-query): Remove unnused var `allwidgets`. + (mairix-widget-create-query): Remove unused var `allwidgets`. 2021-02-09 Juri Linkov <juri@linkov.net> @@ -40177,7 +40177,7 @@ * lisp/simple.el (recenter-current-error): New command. * lisp/progmodes/grep.el (grep-mode-map): - Delete bidings for n and p. + Delete bindings for n and p. * lisp/progmodes/compile.el (compilation-minor-mode-map): Move here the n and p bindings. @@ -41213,7 +41213,7 @@ 2021-02-02 Lars Ingebrigtsen <larsi@gnus.org> - Fix up invalid_syntax error signalling + Fix up invalid_syntax error signaling * src/lread.c (invalid_syntax_lisp): Instead of putting the line/column in a string, signal an error containing the numbers as @@ -41694,7 +41694,7 @@ in a global minor mode. This commit fixes bug #45792. * lisp/international/quail.el (quail-show-guidance): Test the major mode is - not minibuffer-inactive-mode before proceding with the function. + not minibuffer-inactive-mode before proceeding with the function. 2021-01-31 Lars Ingebrigtsen <larsi@gnus.org> @@ -43613,7 +43613,7 @@ RFC2047-encode invalid Subject/From headers (bug#45925). This will make them be displayed more consistently in the Summary buffer (but still "wrong" sometimes, since there's not that much - we can guess at at this stage, charset wise). + we can guess at this stage, charset wise). (nnml-parse-head): Use it. 2021-01-22 Michael Albinus <michael.albinus@gmx.de> @@ -48572,7 +48572,7 @@ c-laomib-loop. Insert code which calls c-laomib-loop minimally, with the help of the new cache. - * lisp/progmodes/cc-mode.el (c-basic-common-init): Initialize the new cach + * lisp/progmodes/cc-mode.el (c-basic-common-init): Initialize the new cache (at mode start). (c-before-change): Invalidate the new cache. (c-fl-decl-start): Add an extra check (> (point) bod-lim) to prevent looping. @@ -49106,7 +49106,7 @@ (comp-split-pos-neg): Minor. (comp-normalize-typeset): Logic update. (comp-union-typesets): Minor. - (comp-intersect-two-typesets): New functio. + (comp-intersect-two-typesets): New function. (comp-intersect-typesets): Logic update. (comp-range-union, comp-range-intersection): Minor. (comp-cstr-union-homogeneous, comp-cstr-union-1-no-mem) @@ -50078,7 +50078,7 @@ Optimize c-parse-state for large buffers with few (if any) braces. * lisp/progmodes/cc-engine.el (c-get-fallback-scan-pos): Search a maximum of - 50,000 characters back for the two BODs. Return nil if we dont' find them. + 50,000 characters back for the two BODs. Return nil if we don't find them. (c-parse-state-get-strategy): For strategy `forward', always use the position `good-pos' for `start-point', even when there's a change of current macro. Deal with a possible return value of nil from c-get-fallback-scan-pos (as @@ -50911,7 +50911,7 @@ 2020-12-12 Lars Ingebrigtsen <larsi@gnus.org> - Alter the "Redundant pcase patter" warning message + Alter the "Redundant pcase pattern" warning message * lisp/emacs-lisp/pcase.el (pcase--expand): Make the "Redundant pcase pattern" warning less vague (bug#31350). @@ -54142,7 +54142,7 @@ Tweak the face of unknown backend indicators in flymake * lisp/progmodes/flymake.el (flymake--mode-line-format): Don't put - a face on the the "?" unknown backend indicator, because that + a face on the "?" unknown backend indicator, because that looks odd in inactive windows (bug#44689). 2020-11-24 Paul W. Rankin <pwr@skeletons.cc> @@ -55996,7 +55996,7 @@ 2020-11-12 Andrea Corallo <akrl@sdf.org> - Unline some functions to optimize bootstrap time + Uninline some functions to optimize bootstrap time * lisp/emacs-lisp/comp.el (comp-mvar-value-vld-p) (comp-mvar-value, comp-mvar-fixnum-p, comp-set-op-p) @@ -56612,7 +56612,7 @@ 2020-11-07 Andrea Corallo <akrl@sdf.org> - Allow for manually bumbing new native compiler ABI versions + Allow for manually bumping new native compiler ABI versions * src/comp.c (ABI_VERSION): Define macro. (hash_native_abi): Include ABI_VERSION in the hashing. @@ -61229,7 +61229,7 @@ 2020-10-14 Andrea Corallo <akrl@sdf.org> - Have `native-elisp-load' return the last registerd function + Have `native-elisp-load' return the last registered function * lisp/emacs-lisp/comp.el (comp-emit-for-top-level): Synthesize 'top_level_run' so it returns the last value returned by @@ -63478,7 +63478,7 @@ user-error when there's a wrong password (bug#43704). (epa--wrong-password-p): New function. (epa-file-insert-file-contents): Use it, and stash the error away - for later signalling. + for later signaling. * lisp/emacs-lisp/subr-x.el (if-let): Autoload. @@ -65831,7 +65831,7 @@ Better error handling after calling 'gcc_jit_context_compile_to_file' - Typically errors are catched in 'compile_function' but in case + Typically errors are caught in 'compile_function' but in case libgccjit throw an error only afterwards while compiling the whole compilation unit we have to report it correctly. @@ -67774,7 +67774,7 @@ 2020-09-05 Lars Ingebrigtsen <larsi@gnus.org> - Revert "Display name with with spaces, but keep symbol name underneath" + Revert "Display name with spaces, but keep symbol name underneath" This reverts commit e0c77bb62c1c950a82ea0517646d989dc5c1fe27. @@ -67854,7 +67854,7 @@ 2020-09-05 ej-32u <ej32u@protonmail.com> (tiny change) - Display name with with spaces, but keep symbol name underneath + Display name with spaces, but keep symbol name underneath * lisp/cus-edit.el (custom-unlispify-menu-entry): Display the pretty name, but keep the real symbol name as the value (bug#41905). @@ -73089,7 +73089,7 @@ * lisp/textmodes/tex-mode.el (tex-font-lock-keywords-2): End the expression before the terminating $ in constructions like $\it identifiername$ - (bug#28277). This avoids italicising the final $ character. + (bug#28277). This avoids italicizing the final $ character. This fixes the final $ of the final test case here: @@ -73421,7 +73421,7 @@ 2020-08-08 Lars Ingebrigtsen <larsi@gnus.org> - Modernise a code example in os.texi + Modernize a code example in os.texi * doc/lispref/os.texi (Session Management): Use with-current-buffer in the example instead of save+switch (bug#40341). @@ -75687,7 +75687,7 @@ * lisp/net/eww.el (eww-list-bookmarks): Don't show buffer if there are no bookmarks. (Bug#41385) - (eww-bookmark-prepare): Move signalling an error if there are no + (eww-bookmark-prepare): Move signaling an error if there are no bookmarks from here... (eww-read-bookmarks): ...to here. Add new argument `error-out' to control this. @@ -75941,7 +75941,7 @@ 2020-07-13 Andrea Corallo <akrl@sdf.org> - Rework the backend to allocate arument arrays for call by references + Rework the backend to allocate argument arrays for call by references * src/comp.c (comp_t): Add 'zero' field. (emit_limple_call_ref): Allocate an array to host the parameters @@ -76328,7 +76328,7 @@ Add a simple pass to infer pure functions not explicitly declared as such. Use this information only during compilation (speed 3) to - optimize out function calls whe possible. + optimize out function calls when possible. 2020-07-09 Andrea Corallo <akrl@sdf.org> @@ -77634,7 +77634,7 @@ Add an initial implementation to support dynamic scope. Arg parsing/binding it's done using the existing code in use for - bytecode (no ad-hoc code is synthetized for that). + bytecode (no ad-hoc code is synthesized for that). * src/lisp.h (struct Lisp_Subr): Add lambda_list field. (SUBR_NATIVE_COMPILED_DYNP): New inliner. @@ -78012,7 +78012,7 @@ cd4f75bb86 Rename default function to next-error-buffer-unnavigated-c... 1dff0a8949 * lisp/image-mode.el (image-toggle-display-image): Fix fit... a71d1787f1 * doc/misc/tramp.texi (Predefined connection information):... - 079b0dc430 Delete, don't kill, dir dir fragments in icomplete-fido-ba... + 079b0dc430 Delete, don't kill, dir fragments in icomplete-fido-ba... 6cdecc2659 Revert markup change in with-coding-priority docs 22f4fba8a9 * lisp/emulation/cua-rect.el (cua--rectangle-region-insert... 6b9eac6759 * lisp/simple.el (shell-command-on-region): Fix docstring. @@ -78249,7 +78249,7 @@ (comp-latch-make-fill): New function. (comp-emit-uncond-jump, comp-emit-cond-jump): Update to emit latches. - (comp-new-block-sym): Add a postfix paramenter. + (comp-new-block-sym): Add a postfix parameter. 2020-06-13 Andrea Corallo <akrl@sdf.org> @@ -78602,7 +78602,7 @@ Fix comp-call-optim-form-call for null `callee' * lisp/emacs-lisp/comp.el (comp-call-optim-form-call): Guard - agains null `calle'. + against null `calle'. 2020-06-07 Glenn Morris <rgm@gnu.org> @@ -79675,7 +79675,7 @@ Simply return the directory selected by the user. (project-switch-project-find-file): Remove. (project-switch-project-dired): Rename to project-dired and make - it follow the convention of existing projec tcommands. + it follow the convention of existing project tcommands. (project-switch-project-eshell): Ditto. (project-switch-project): Instead of passing the project instance to the command, just bind default-directory. @@ -80910,7 +80910,7 @@ 'lambda_gc_guard' 'lambda_c_name_idx_h' 'data_imp_relocs' 'loaded_once' fields. - * src/comp.c (load_comp_unit): Use compilaiton unit 'loaded_once' + * src/comp.c (load_comp_unit): Use compilation unit 'loaded_once' field. (make_subr, Fcomp__register_lambda): New functions. (Fcomp__register_subr): Make use of 'make_subr'. @@ -81264,7 +81264,7 @@ Fix bug #40992 whilst still allowing breakpoint highlights in edebug Strategy: when an instrumented function gets re-evaluated, save the former - value of its symbol's `edebug' property in the new propery `ghost-edebug'. If + value of its symbol's `edebug' property in the new property `ghost-edebug'. If this function is still being edebugged, edebug will then access its info from this new property. @@ -83843,7 +83843,7 @@ Implement position independent dump. - Set the filename for every compilation unit as realtive to obtain a + Set the filename for every compilation unit as relative to obtain a position independent dump. * lisp/loadup.el: Modify filename for every compilation unit as @@ -84397,7 +84397,7 @@ * lisp/arc-mode.el: Rewrite displaying the summaries - Completely rewrite the code that displayes the summaries, so all + Completely rewrite the code that displays the summaries, so all backends share the same code. (archive--summarize-descs): New function. @@ -86075,7 +86075,7 @@ Merge remote-tracking branch 'savannah/master' into HEAD -2020-03-10 AndreaCorallo <akrl@sdf.org> +2020-03-10 Andrea Corallo <akrl@sdf.org> * Improve load_comp_unit @@ -86084,7 +86084,7 @@ Guard also data_ephemeral_vec against compiler optimizations. -2020-03-10 AndreaCorallo <akrl@sdf.org> +2020-03-10 Andrea Corallo <akrl@sdf.org> * Fix store_function_docstring for native functions @@ -86098,7 +86098,7 @@ native_intspec and native_doc fields has to be reached by the subr cause are not anymore in the CU. -2020-03-10 AndreaCorallo <akrl@sdf.org> +2020-03-10 Andrea Corallo <akrl@sdf.org> * Set relocation class as ephemeral in `comp-limplify-top-level' @@ -86547,17 +86547,17 @@ * lisp/replace.el (occur-1): Update default-directory in occur buffer. -2020-03-04 AndreaCorallo <akrl@sdf.org> +2020-03-04 Andrea Corallo <akrl@sdf.org> * Do not crash if the output directory is created in the meanwhile -2020-03-03 AndreaCorallo <akrl@sdf.org> +2020-03-03 Andrea Corallo <akrl@sdf.org> Hash eln ABI once and add it to the output compilation path Fix org for eln new compilation folder layout -2020-03-03 AndreaCorallo <akrl@sdf.org> +2020-03-03 Andrea Corallo <akrl@sdf.org> Rework `find-lisp-object-file-name' @@ -86668,7 +86668,7 @@ and 'fill-column' values. (Bug#36837) (whitespace-lines-regexp): New function. -2020-03-01 AndreaCorallo <akrl@sdf.org> +2020-03-01 Andrea Corallo <akrl@sdf.org> * ; Clean-up out of date comment @@ -86718,11 +86718,11 @@ * src/pdumper.c (dump_object): Fix hash for Lisp_Type after commit 202c3319a28c029d6971dccea92f92425c5e8067. -2020-02-29 AndreaCorallo <akrl@sdf.org> +2020-02-29 Andrea Corallo <akrl@sdf.org> Introduce 'effective_load_path' -2020-02-29 AndreaCorallo <akrl@sdf.org> +2020-02-29 Andrea Corallo <akrl@sdf.org> * Keep comp-subr-list into pure space @@ -87689,7 +87689,7 @@ (lispref/modes.texi): Explain avoiding lambdas on hooks. -2020-02-06 AndreaCorallo <akrl@sdf.org> +2020-02-06 Andrea Corallo <akrl@sdf.org> Add system-configuration in the compilation output path @@ -87713,7 +87713,7 @@ Add function ssa-status as `comp-func' slot and have `comp-clean-ssa' to run when necessary. -2020-03-01 AndreaCorallo <akrl@sdf.org> +2020-03-01 Andrea Corallo <akrl@sdf.org> Remove relocation index form LIMPLE setimm @@ -87739,21 +87739,21 @@ Merge remote-tracking branch 'savannah/master' into HEAD -2020-02-26 AndreaCorallo <akrl@sdf.org> +2020-02-26 Andrea Corallo <akrl@sdf.org> * ; Add a TODO for a future optimization -2020-02-26 AndreaCorallo <akrl@sdf.org> +2020-02-26 Andrea Corallo <akrl@sdf.org> Store optimize qualities into .eln files For now just comp-speed and comp-debug are stored. -2020-02-26 AndreaCorallo <akrl@sdf.org> +2020-02-26 Andrea Corallo <akrl@sdf.org> - Rename d-base allocation classe into d-default + Rename d-base allocation class into d-default -2020-02-26 AndreaCorallo <akrl@sdf.org> +2020-02-26 Andrea Corallo <akrl@sdf.org> Add ephemeral relocation data class @@ -87793,7 +87793,7 @@ Test 'comp-eq' should not assume any string hashing policy -2020-02-21 AndreaCorallo <akrl@sdf.org> +2020-02-21 Andrea Corallo <akrl@sdf.org> Emit 'top_level_run' objects as impure @@ -87801,7 +87801,7 @@ Verify '--with-nativecomp' has also '--with-dumping=pdumper' -2020-02-21 AndreaCorallo <akrl@sdf.org> +2020-02-21 Andrea Corallo <akrl@sdf.org> Reorder m-var slots @@ -87819,7 +87819,7 @@ Use `sxhash-eq' to generate mvar SSA ids -2020-02-15 AndreaCorallo <akrl@sdf.org> +2020-02-15 Andrea Corallo <akrl@sdf.org> Speed 2 goes default @@ -87832,7 +87832,7 @@ Every function call by reference gets use one unique array of arguments. -2020-02-14 AndreaCorallo <akrl@sdf.org> +2020-02-14 Andrea Corallo <akrl@sdf.org> Clean-up old gc disable refuse in comp-tests-non-locals @@ -88071,7 +88071,7 @@ Always define subr-native-elisp-p also without native compiler -2020-02-03 AndreaCorallo <akrl@sdf.com> +2020-02-03 Andrea Corallo <akrl@sdf.com> Fix load_comp_unit for non zero speeds @@ -90740,7 +90740,7 @@ compute dominator tree - ssa and endge number generation with generator + ssa and edge number generation with generator add edge computation @@ -91228,7 +91228,7 @@ optimize primitive native call - propagate contant types and optimize self calls + propagate constant types and optimize self calls introduce stack_el_t @@ -91466,7 +91466,7 @@ introduce CASE_CALL_NARGS macro and add various ops - symbol_function set fset fget fget Bsubstring + symbol_function set fset fget Bsubstring 2020-01-01 Andrea Corallo <andrea_corallo@yahoo.it> @@ -93578,7 +93578,7 @@ 2021-02-03 Michael Albinus <michael.albinus@gmx.de> - Fix an error in tramp-sh-handle-make-process. Dont' merge with master + Fix an error in tramp-sh-handle-make-process. Don't merge with master * lisp/net/tramp-sh.el (tramp-sh-handle-make-process): Don't use heredoc script whent the argument contains a string. @@ -95039,7 +95039,7 @@ 2020-06-13 João Távora <joaotavora@gmail.com> - Delete, don't kill, dir dir fragments in icomplete-fido-backward-updir + Delete, don't kill, dir fragments in icomplete-fido-backward-updir Reported by: Andrew Schwartzmeyer <andrew@schwartzmeyer.com> @@ -101413,7 +101413,7 @@ vc-hg: prompt for branch to merge * lisp/vc/vc-hg.el (vc-hg-merge-branch): Prompt for revision to merge. - (vc-hg-revision-table): Use branches, tags and bookmarks as competion + (vc-hg-revision-table): Use branches, tags and bookmarks as completion candidates. * etc/NEWS: Mention changes of vc-hg.el @@ -101483,7 +101483,7 @@ (Create_Pixmap_From_Bitmap_Data): (xpm_load): Use new function. * src/xterm.c (x_composite_image): Use PictOpOver when there is a mask - so the transparency is honoured. + so the transparency is honored. (x_draw_image_foreground_1): Use x_composite_image. 2019-11-29 Stefan Monnier <monnier@iro.umontreal.ca> @@ -103042,7 +103042,7 @@ open-paren-in-column-0-is-defun-start to nil) fixes bug #37910. It may also have fixed bug #5490 and bug #18072. - * lisp/progmodes/cc-engine.el (c-state-cache-non-literal-place): Remove thi + * lisp/progmodes/cc-engine.el (c-state-cache-non-literal-place): Remove this non-sensical function, replacing it with .... (c-state-cache-lower-good-pos): New function. (c-renarrow-state-cache, c-append-lower-brace-pair-to-state-cache) @@ -110631,7 +110631,7 @@ Fix reversed check in mm-possibly-verify-or-decrypt * lisp/gnus/mm-decode.el (mm-possibly-verify-or-decrypt): Fix - reverse check thinko that made unverified singed messages not + reverse check thinko that made unverified signed messages not display correctly. 2019-09-27 Wilson Snyder <wsnyder@wsnyder.org> @@ -113664,7 +113664,7 @@ Make the NSM not pop up an X dialogue on non-mouse actions * lisp/emacs-lisp/rmc.el (read-multiple-choice): Don't pop up X - dialogues on (url-retrieve "https://expired.badssl.com/" #'ignore) + dialogs on (url-retrieve "https://expired.badssl.com/" #'ignore) and the like. 2019-09-04 Lars Ingebrigtsen <larsi@gnus.org> @@ -115157,7 +115157,7 @@ 2019-08-21 Lars Ingebrigtsen <larsi@gnus.org> - Make hide-ifdef-mode-prefix-key customisable + Make hide-ifdef-mode-prefix-key customizable * lisp/progmodes/hideif.el (hide-ifdef-mode-prefix-key): Make into a defcustom since it seems like this is something that should be @@ -117900,7 +117900,7 @@ (readbyte_from_file): Assert that `infile` is set. (close_infile_unwind): Reset `infile` to its previous value rather than to NULL. - (Fload): Remember the previous value of `infile` before chaning it. + (Fload): Remember the previous value of `infile` before changing it. (readevalloop): Don't set `infile` any more. 2019-07-31 Paul Eggert <eggert@cs.ucla.edu> @@ -118316,7 +118316,7 @@ * lisp/mh-e/mh-speed.el (mh-speed-parse-flists-output): * lisp/mh-e/mh-search.el (mh-index-parse-search-regexp): Avoid - warning about `values-list' by using `cl-values-list' insead. + warning about `values-list' by using `cl-values-list' instead. 2019-07-29 Lars Ingebrigtsen <larsi@gnus.org> @@ -126255,7 +126255,7 @@ Suppress warning about non-prefixed variable in mailalias.el - * lisp/mail/mailalias.el (patters): Suppress warning about + * lisp/mail/mailalias.el (pattern): Suppress warning about non-prefixed variable used by `mail-complete-alist'. 2019-06-15 Lars Ingebrigtsen <larsi@gnus.org> @@ -130261,7 +130261,7 @@ 8192 bytes is a reasonable number nowadays given typical file system design. * test/lisp/image-tests.el (image-tests--emacs-images-directory): - New contant. + New constant. (image-type-from-file-header-test): New test. 2019-05-18 Michael Albinus <michael.albinus@gmx.de> @@ -130524,7 +130524,7 @@ 2019-05-16 Lars Ingebrigtsen <larsi@gnus.org> - Avoind string-as-multibyte in ps-output-string-prim + Avoid string-as-multibyte in ps-output-string-prim * lisp/ps-print.el (ps-output-string-prim): Avoid `string-as-multibyte', and encode as utf-8 instead if multibyte. @@ -130710,7 +130710,7 @@ Fix diff-mode face problem when used in terminals (Bug#35695) In a terminal supporting 256 colors, both diff-added and diff-removed - was mapped to the same greyish color. + was mapped to the same grayish color. * lisp/vc/diff-mode.el: Modify the colors of diff-removed, diff-added, diff-refine-removed, and diff-refine-added when @@ -136480,7 +136480,7 @@ Check gnus-newsgroup-dependencies is hash table in gnus-id-to-thread * lisp/gnus/gnus-sum.el (gnus-id-to-thread): If dependencies haven't - been initialized yet, don't blow up. Mimicks previous (non hasht + been initialized yet, don't blow up. Mimics previous (non hash table) behavior. 2019-03-31 Mattias Engdegård <mattiase@acm.org> @@ -140170,7 +140170,7 @@ * doc/misc/eshell.texi (Built-ins): Fix alias description - Dear eamcs developers, eshells current documentation first states + Dear emacs developers, eshell's current documentation first states that alias definitions are not saved to an alias file, later that they are saved to an alias file. I tested it and the latter is correct. @@ -156879,7 +156879,7 @@ Merge from origin/emacs-26 90bea37 ; * etc/PROBLEMS: Fix fvwm version number in last commit - af82d1f * etc/PROBLEMS: Document stickyness problem with FVWM (Bug#31... + af82d1f * etc/PROBLEMS: Document stickiness problem with FVWM (Bug#31... 4a3aed2 Update Emacs Lisp Intro to match current behavior 21f2247 Merge branch 'emacs-26' of git.savannah.gnu.org:/srv/git/emac... 3257085 Fix previous commit @@ -158744,7 +158744,7 @@ 2018-04-17 Basil L. Contovounesios <contovob@tcd.ie> - Modernise face specs and set version tags in eww/shr + Modernize face specs and set version tags in eww/shr * lisp/net/shr.el (shr-strike-through, shr-link, shr-selected-link): Set :version tag (bug#31200). @@ -159218,10 +159218,10 @@ 2018-04-14 Lars Ingebrigtsen <larsi@gnus.org> - Modernise a Gnus function a bit + Modernize a Gnus function a bit * lisp/gnus/gnus-start.el (gnus-update-active-hashtb-from-killed): - Modernise code a bit. + Modernize code a bit. 2018-04-14 Lars Ingebrigtsen <larsi@gnus.org> @@ -165960,7 +165960,7 @@ cl-loop: Calculate the array length just once * lisp/emacs-lisp/cl-macs.el (cl--parse-loop-clause): - Dont calculate the array length on each iteration (Bug#29866). + Don't calculate the array length on each iteration (Bug#29866). 2018-01-07 Philipp Stephani <phst@google.com> @@ -166738,7 +166738,7 @@ 5a7d009 * lisp/vc/smerge-mode.el (smerge-refine): Replace obsolete al... e019c35 FOR_EACH_FRAME no longer assumes frame-list d64b88d * src/font.c (Ffont_info): Doc fix. (Bug#29682) - 92b2604 Modernise message.el face spec syntax + 92b2604 Modernize message.el face spec syntax b1efbe6 Update message.el obsolete face aliases 2494c14 ; * lisp/comint.el (comint-terminfo-terminal): Add a :version... 12ad276 Improve documentation of TERM environment variable @@ -167034,7 +167034,7 @@ 5a7d0095a4 * lisp/vc/smerge-mode.el (smerge-refine): Replace obsolete... e019c35df6 FOR_EACH_FRAME no longer assumes frame-list d64b88da2f * src/font.c (Ffont_info): Doc fix. (Bug#29682) - 92b2604a7f Modernise message.el face spec syntax + 92b2604a7f Modernize message.el face spec syntax b1efbe6564 Update message.el obsolete face aliases 2494c14e76 ; * lisp/comint.el (comint-terminfo-terminal): Add a :vers... 12ad276d15 Improve documentation of TERM environment variable @@ -169297,7 +169297,7 @@ 2e1b3522b8 Improve documentation of 'line-number-display-width' 5b6e59cfdb Implement vc-default-dir-extra-headers for vc-rcs 22adeca42a In NEWS give advice on use of `switch-to-buffer' (Bug#28645) - 2c3e6f1ddc Dont update primary selection with winner-undo + 2c3e6f1ddc Don't update primary selection with winner-undo b38724ab67 Work around ImageMagick bug 825 20cc68e871 Document rectangle-preview option more (Bug#27974) a0b7b301dd Do not reject https://gnu.org in commit messages @@ -172340,7 +172340,7 @@ * doc/misc/eshell.texi (Built-ins): Fix alias description - Dear eamcs developers, eshells current documentation first states + Dear emacs developers, eshell's current documentation first states that alias definitions are not saved to an alias file, later that they are saved to an alias file. I tested it and the latter is correct. @@ -176909,7 +176909,7 @@ 2018-06-02 Martin Rudalics <rudalics@gmx.at> - * etc/PROBLEMS: Document stickyness problem with FVWM (Bug#31650) + * etc/PROBLEMS: Document stickiness problem with FVWM (Bug#31650) 2018-06-01 Eli Zaretskii <eliz@gnu.org> @@ -181827,7 +181827,7 @@ 2017-12-15 Basil L. Contovounesios <contovob@tcd.ie> - Modernise message.el face spec syntax + Modernize message.el face spec syntax * lisp/gnus/message.el (message-header-to, message-header-cc) (message-header-subject, message-header-newsgroups) @@ -184352,7 +184352,7 @@ * src/lisp.h (COMMON_MULTIPLE): Move here from alloc.c. * src/thread.c (THREAD_ALIGNMENT): New macro. - (main_thread): Use THREAD_ALIGNMENT to align propertly. (Bug#29040) + (main_thread): Use THREAD_ALIGNMENT to align properly. (Bug#29040) 2017-10-28 Eli Zaretskii <eliz@gnu.org> @@ -185296,10 +185296,10 @@ 2017-10-17 Tino Calancha <tino.calancha@gmail.com> Noam Postavsky <npostavs@gmail.com> - Dont update primary selection with winner-undo + Don't update primary selection with winner-undo * lisp/winner.el (winner-set): - Dont update primary selection when select-enable-primary + Don't update primary selection when select-enable-primary is non-nil (Bug#28631). 2017-10-17 Paul Eggert <eggert@cs.ucla.edu> @@ -185648,7 +185648,7 @@ Add mode map to Flymake diagnostic button * lisp/progmodes/flymake.el (flymake--diagnostics-buffer-entries): Add - keymap propery. + keymap property. 2017-10-10 João Távora <joaotavora@gmail.com> @@ -192051,7 +192051,7 @@ 2017-08-09 Tino Calancha <tino.calancha@gmail.com> - Ask files for deletion in buffer order: top first, botton later + Ask files for deletion in buffer order: top first, bottom later * lisp/dired.el (dired-do-flagged-delete, dired-do-delete): Call `nreverse' t invert the output of `dired-map-over-marks'. @@ -194580,7 +194580,7 @@ 2017-07-09 R. Bernstein <rocky@gnu.org> - Add realgud faces faces to whiteboard... + Add realgud faces to whiteboard... Adjust wheatgrass to use underline for enabled/disabled breakpoints @@ -195520,7 +195520,7 @@ Ignore mouse-movement for describe-key-briefly (Bug#12204) - * lisp/help.el (help-read-key-sequence): Add optional argument ot + * lisp/help.el (help-read-key-sequence): Add optional argument to ignore `mouse-movement' events. (describe-key-briefly): Use it. * doc/emacs/help.texi (Key Help): @@ -198690,7 +198690,7 @@ (tramp-adb-ls-toolbox-regexp): Ignore addition links column on Android 7. (tramp-adb-get-ls-command): - Dont use --color=none when using toybox (Android 7). It's not + Don't use --color=none when using toybox (Android 7). It's not possible to disable coloring explicitly for toybox ls. 2017-05-27 Svante Carl v. Erichsen <Svante.v.Erichsen@web.de> (tiny change) @@ -199186,7 +199186,7 @@ 2017-05-23 Paul Eggert <eggert@cs.ucla.edu> - Don't warn about missing brances on macOS + Don't warn about missing branches on macOS On macOS, removing -Wmissing-braces is not enough; the warning has to be disabled explicitly. @@ -208945,7 +208945,7 @@ Revamp quitting and fix infloops - This fixes some infinite loops that cannot be quitted out of, + This fixes some infinite loops that cannot be quit out of, e.g., (defun foo () (nth most-positive-fixnum '#1=(1 . #1#))) when byte-compiled and when run under X. See: https://lists.gnu.org/r/emacs-devel/2017-01/msg00577.html @@ -214158,7 +214158,7 @@ refactor systhread.h This refactors systhread.h to move the notion of a "lisp mutex" - into thread.c. This lets us make make the global lock and + into thread.c. This lets us make the global lock and post_acquire_global_lock static. 2012-08-17 Tom Tromey <tromey@redhat.com> @@ -218796,7 +218796,7 @@ * lib/stdint.in.h, m4/extensions.m4, m4/stdint.m4, m4/stdio_h.m4: * m4/sys_types_h.m4: Copy from gnulib. * lib/gnulib.mk, m4/gnulib-comp.m4: Regenerate. - * lib/limits.in.h, m4/limits-h.m4: New files, copie from gnulib. + * lib/limits.in.h, m4/limits-h.m4: New files, copied from gnulib. * nt/gnulib.mk: Merge changes from lib/gnulib.mk. 2016-09-15 Michael Albinus <michael.albinus@gmx.de> @@ -219462,7 +219462,7 @@ 2016-09-02 Stefan Monnier <monnier@iro.umontreal.ca> - Check actual contents before promting about changed file + Check actual contents before prompting about changed file * lisp/userlock.el (userlock--check-content-unchanged) (userlock--ask-user-about-supersession-threat): New functions. @@ -220696,7 +220696,7 @@ * lisp/progmodes/cc-mode.el (c-after-change): When we detect a missing invocation of c-before-change-functions, we assume the changed region is the - entire buffer, and call c-before-change explicitly before proceding. + entire buffer, and call c-before-change explicitly before proceeding. 2016-08-09 Alan Mackenzie <acm@muc.de> @@ -221327,8 +221327,8 @@ is never used. Hardcode the syntax so that the compilar can detect such dead code and remove it from compiled code. - The only exception is RE_NO_POSIX_BACKTRACKING which can be separatelly - specified. Handle this separatelly with a function argument (replacing + The only exception is RE_NO_POSIX_BACKTRACKING which can be separately + specified. Handle this separately with a function argument (replacing now unnecessary syntax argument). With this patchset, size of Emacs binary on x86_64 machine is reduced by @@ -223962,10 +223962,10 @@ 2016-06-15 Stefan Monnier <monnier@iro.umontreal.ca> - Advertize set-keymap-parent as replacement for copy-keymap + Advertise set-keymap-parent as replacement for copy-keymap * doc/lispref/keymaps.texi (Creating Keymaps): - * src/keymap.c (Fcopy_keymap): Advertize set-keymap-parent as replacement. + * src/keymap.c (Fcopy_keymap): Advertise set-keymap-parent as replacement. 2016-06-15 Ted Zlatanov <tzz@lifelogs.com> @@ -226537,7 +226537,7 @@ Fix Bug#10085 * lisp/net/tramp.el (tramp-find-foreign-file-name-handler): - Add optional arguments OPERATION and COMPETION. Handle + Add optional arguments OPERATION and COMPLETION. Handle `file-name-as-directory', `file-name-directory' and `file-name-nondirectory' also in completion mode. (tramp-file-name-handler): Use it. (Bug#10085) @@ -226854,7 +226854,7 @@ 2016-04-30 Lars Ingebrigtsen <larsi@gnus.org> - Document mode mode line variables + Document mode line variables * doc/lispref/modes.texi (Mode Line Variables): Document `mode-line-front-space, `mode-line-misc-info', @@ -227546,7 +227546,7 @@ of the data end marker from here... (bug#23020). (smtpmail-send-data): ... to here, so that we don't get a "Sending done" before we've sent the final "." (which can make - the SMPT server reject the email. + the SMTP server reject the email. 2016-04-25 Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -227801,7 +227801,7 @@ * lisp/auth-source.el (auth-source-macos-keychain-search-items): Handle keychain - output correctly when has special chararcters (bug#22824). + output correctly when has special characters (bug#22824). 2016-04-24 Magnus Henoch <magnus.henoch@gmail.com> diff --git a/Makefile.in b/Makefile.in index 45b4a59e3db..93609a4e166 100644 --- a/Makefile.in +++ b/Makefile.in @@ -405,16 +405,18 @@ actual-all: ${SUBDIR} info $(gsettings_SCHEMAS:.xml=.valid) src-depending-on-lis # ADVICE-ON-FAILURE-END:bootstrap advice-on-failure: + @[ -f .no-advice-on-failure ] && exit ${exit-status}; true @echo >&2 '***' @echo >&2 '*** '"\"make ${make-target}\" failed with exit status ${exit-status}." @echo >&2 '***' @cat Makefile | \ - sed -n '/^# ADVICE-ON-FAILURE-BEGIN:${make-target}/,$${p;/^# ADVICE-ON-FAILURE-END:${make-target}/q};' | \ - sed 's/^# /*** /' | grep -v '^*** ADVICE-ON-FAILURE-' >&2 + sed -n '/^# ADVICE-ON-FAILURE-BEGIN:${make-target}/,$${p;/^# ADVICE-ON-FAILURE-END:${make-target}/q;};' | \ + sed 's/^# /*** /' | grep -v '^\*\*\* ADVICE-ON-FAILURE-' >&2 @echo >&2 '***' @exit ${exit-status} sanity-check: + @[ -f .no-advice-on-failure ] && exit 0; true @v=$$(src/emacs${EXEEXT} --batch --eval \ '(progn (defun f (n) (if (= 0 n) 1 (* n (f (- n 1))))) (princ (f 10)))' \ 2> /dev/null); \ @@ -423,8 +425,8 @@ sanity-check: echo >&2 '*** '"\"make ${make-target}\" succeeded, but Emacs is not functional."; \ echo >&2 '***'; \ cat Makefile | \ - sed -n '/^# ADVICE-ON-FAILURE-BEGIN:${make-target}/,$${p;/^# ADVICE-ON-FAILURE-END:${make-target}/q};' | \ - sed 's/^# /*** /' | grep -v '^*** ADVICE-ON-FAILURE-' >&2; \ + sed -n '/^# ADVICE-ON-FAILURE-BEGIN:${make-target}/,$${p;/^# ADVICE-ON-FAILURE-END:${make-target}/q;};' | \ + sed 's/^# /*** /' | grep -v '^\*\*\* ADVICE-ON-FAILURE-' >&2; \ echo >&2 '***'; \ exit 1 diff --git a/admin/cus-test.el b/admin/cus-test.el index 22d5a3a1516..7e73f2e44aa 100644 --- a/admin/cus-test.el +++ b/admin/cus-test.el @@ -131,7 +131,7 @@ Names should be as they appear in loaddefs.el.") ;; Don't create a file `abbrev-file-name'. (setq save-abbrevs nil) -;; Avoid compile logs from adviced functions. +;; Avoid compile logs from advised functions. (eval-after-load "bytecomp" '(setq ad-default-compilation-action 'never)) diff --git a/admin/grammars/srecode-template.wy b/admin/grammars/srecode-template.wy index c3531ebd549..7ba73d2921a 100644 --- a/admin/grammars/srecode-template.wy +++ b/admin/grammars/srecode-template.wy @@ -126,7 +126,7 @@ variable : SET symbol insertable-string-list newline (VARIABLE-TAG $2 nil $3) | SET symbol number newline - ;; This so a common error w/ priority works. + ;; This so a common error with priority works. ;; Note that "number" still has a string value in the lexer. (VARIABLE-TAG $2 nil (list $3)) | SHOW symbol newline diff --git a/admin/last-chance.el b/admin/last-chance.el index 30d6a25a287..45d470cacde 100644 --- a/admin/last-chance.el +++ b/admin/last-chance.el @@ -41,7 +41,7 @@ ;; ;; will show you any references to `change-log-date-face' in the ;; *.el files in a new buffer (in Grep mode). Hopefully you see -;; only the obsolete declaration and can proceed w/ its removal. +;; only the obsolete declaration and can proceed with its removal. ;; If not, please DTRT and refrain from the removal until those ;; references are properly transitioned. ;; diff --git a/admin/notes/bug-triage b/admin/notes/bug-triage index 3d9a275c9d2..bee7242337d 100644 --- a/admin/notes/bug-triage +++ b/admin/notes/bug-triage @@ -73,7 +73,7 @@ the ones that are not reproducible on the current release. know if you are able to? If I don't hear back in a few weeks, I'll just close this bug as unreproducible." [ ] Check that the priority is reasonable. Most bugs should be - marked as normal, but crashers and security issues can be + marked as normal, but crashes and security issues can be marked as serious. 3. Your changes will take some time to take effect. After a period of minutes to hours, you will get a mail telling you the control message has been diff --git a/doc/emacs/ChangeLog.1 b/doc/emacs/ChangeLog.1 index 048b7bd99a5..6669e28e6b5 100644 --- a/doc/emacs/ChangeLog.1 +++ b/doc/emacs/ChangeLog.1 @@ -1356,7 +1356,7 @@ * dired.texi (Dired Deletion, Marks vs Flags): Document Emacs 24.3 changes to the mark and unmark commands. - (Comparison in Dired): Document chages to dired-diff. Remove M-=, + (Comparison in Dired): Document changes to dired-diff. Remove M-=, which is no longer bound to dired-backup-diff. 2012-10-23 Bastien Guerry <bzg@gnu.org> @@ -2711,7 +2711,7 @@ of list-faces-display here, from Standard Faces node. Note special role of `default' background. (Standard Faces): Note special role of `default' background. - Note that region face may be taken fom GTK. Add xref to Text Display. + Note that region face may be taken from GTK. Add xref to Text Display. (Text Scale): Rename from "Temporary Face Changes". Callers changed. Don't bother documenting variable-pitch-mode. (Font Lock): Copyedits. Remove font-lock-maximum-size. diff --git a/doc/emacs/custom.texi b/doc/emacs/custom.texi index 08ada2a70bb..aaf41d2aef1 100644 --- a/doc/emacs/custom.texi +++ b/doc/emacs/custom.texi @@ -805,12 +805,12 @@ C-h v fill-column @key{RET} displays something like this: @example -fill-column is a variable defined in ‘C source code’. +fill-column is a variable defined in @quoteleft{}C source code@quoteright{}. Its value is 70 Automatically becomes buffer-local when set. This variable is safe as a file local variable if its value - satisfies the predicate ‘integerp’. + satisfies the predicate @quoteleft{}integerp@quoteright{}. Probably introduced at or before Emacs version 18. Documentation: @@ -1659,7 +1659,7 @@ events. or lower case; @acronym{ASCII} or non-@acronym{ASCII}) are reserved for users. Emacs itself will never bind those key sequences, and Emacs extensions should avoid binding them. In other words, users can -bind key sequences like @kbd{C-c a} or @kbd{C-c ç} and rely on these +bind key sequences like @kbd{C-c a} or @kbd{C-c @,{c}} and rely on these never being shadowed by other Emacs bindings. @node Prefix Keymaps diff --git a/doc/emacs/dired.texi b/doc/emacs/dired.texi index a9b4ff783d4..7a382c05663 100644 --- a/doc/emacs/dired.texi +++ b/doc/emacs/dired.texi @@ -807,7 +807,7 @@ should create non-existent directories in @var{new}. The option @code{dired-create-destination-dirs-on-trailing-dirsep}, when set in addition to @code{dired-create-destination-dirs}, controls -wether a trailing directory separator at the destination is treated +whether a trailing directory separator at the destination is treated specially. In that case, when renaming a directory @samp{old} to @samp{new/} and no directory @samp{new} exists already, it will be created and @samp{old} is moved into the newly created directory. diff --git a/doc/emacs/maintaining.texi b/doc/emacs/maintaining.texi index 3e03bd817ad..44e9e1896fa 100644 --- a/doc/emacs/maintaining.texi +++ b/doc/emacs/maintaining.texi @@ -1832,6 +1832,8 @@ directory. @xref{Top,Eshell,Eshell, eshell, Eshell: The Emacs Shell}. @item C-x p b Switch to another buffer belonging to the current project (@code{project-switch-to-buffer}). +@item C-x p C-b +List the project buffers (@code{project-list-buffers}). @item C-x p k Kill all live buffers that belong to the current project (@code{project-kill-buffers}). @@ -1847,6 +1849,11 @@ switch between buffers that belong to the current project by prompting for a buffer to switch and considering only the current project's buffers as candidates for completion. +@findex project-list-buffers + Like the command @code{list-buffers} (@pxref{List Buffers}), the +command @kbd{C-x p C-b} (@code{project-list-buffers}) displays a list +of existing buffers, but only belonging to the current project. + @findex project-kill-buffers @vindex project-kill-buffer-conditions @vindex project-kill-buffers-display-buffer-list diff --git a/doc/emacs/mark.texi b/doc/emacs/mark.texi index db96093a171..5472a288d1e 100644 --- a/doc/emacs/mark.texi +++ b/doc/emacs/mark.texi @@ -50,10 +50,10 @@ Ring}. Additionally, some commands will have an effect even on an inactive region (for example @dfn{upcase-region}). You can also reactivate the region with commands like @kbd{C-x C-x}. - The above default behavior is known as Transient Mark mode. -Disabling Transient Mark mode switches Emacs to an alternative -behavior, in which the region is usually not highlighted. -@xref{Disabled Transient Mark}. + The above behavior, which is the default in interactive sessions, is +known as Transient Mark mode. Disabling Transient Mark mode switches +Emacs to an alternative behavior, in which the region is usually not +highlighted. @xref{Disabled Transient Mark}. @vindex highlight-nonselected-windows Setting the mark in one buffer has no effect on the marks in other @@ -455,10 +455,11 @@ motion keys will extend the region set by shift-selection. The default behavior of the mark and region, in which setting the mark activates it and highlights the region, is called Transient Mark -mode. This is a minor mode that is enabled by default. It can be -toggled with @kbd{M-x transient-mark-mode}, or with the -@samp{Highlight Active Region} menu item in the @samp{Options} menu. -Turning it off switches Emacs to an alternative mode of operation: +mode. This is a minor mode that is enabled by default in interactive +sessions. It can be toggled with @kbd{M-x transient-mark-mode}, or +with the @samp{Highlight Active Region} menu item in the +@samp{Options} menu. Turning it off switches Emacs to an alternative +mode of operation: @itemize @bullet @item diff --git a/doc/emacs/package.texi b/doc/emacs/package.texi index e8af35e2e3d..cd4c113ae5a 100644 --- a/doc/emacs/package.texi +++ b/doc/emacs/package.texi @@ -559,7 +559,7 @@ package, without adding it to the package list, use @code{package-vc-checkout}. @vindex package-vc-selected-packages -@findex package-vc-ensure-packages +@findex package-vc-install-selected-packages An alternative way to use @code{package-vc-install} is via the @code{package-vc-selected-packages} user option. This is an alist of packages to install, where each key is a package name and the value is @@ -567,8 +567,8 @@ packages to install, where each key is a package name and the value is indicating a specific revision or a package specification plist. The side effect of setting the user option is to install the package, but the process can also be manually triggered using the function -@code{package-vc-ensure-packages}. Here is an example of how the user -option: +@code{package-vc-install-selected-packages}. Here is an example of +how the user option: @example @group @@ -588,16 +588,16 @@ the current development head or implement a new feature to scratch an itch. If the package metadata indicates how to contact the maintainer, you can use the command @code{package-report-bug} to report a bug via Email. This report will include all the user options -that you have customised. If you have made a change you wish to share +that you have customized. If you have made a change you wish to share with the maintainers, first commit your changes then use the command @code{package-vc-prepare-patch} to share it. @xref{Preparing Patches}. @findex package-vc-install-from-checkout -@findex package-vc-refresh +@findex package-vc-rebuild If you maintain your own packages you might want to use a local checkout instead of cloning a remote repository. You can do this by using @code{package-vc-install-from-checkout}, which creates a symbolic link from the package directory (@pxref{Package Files}) to your checkout -and initialises the code. Note that you might have to use -@code{package-vc-refresh} to repeat the initialisation and update the +and initializes the code. Note that you might have to use +@code{package-vc-refresh} to repeat the initialization and update the autoloads. diff --git a/doc/lispref/display.texi b/doc/lispref/display.texi index c75107fb588..10a1a18dd1c 100644 --- a/doc/lispref/display.texi +++ b/doc/lispref/display.texi @@ -2273,7 +2273,7 @@ complex text shaping requires that for some scripts. When that happens, characters no longer map in a simple way to display columns, and display layout decisions with such strings, such as truncating too wide strings, can be a complex job. This function helps in performing -suvh jobs: it splits up its argument @var{string} into a list of +such jobs: it splits up its argument @var{string} into a list of substrings, where each substring produces a single grapheme cluster that should be displayed as a unit. Lisp programs can then use this list to construct visually-valid substrings of @var{string} which will diff --git a/doc/lispref/errors.texi b/doc/lispref/errors.texi index 44a62dcebca..cb05290abd1 100644 --- a/doc/lispref/errors.texi +++ b/doc/lispref/errors.texi @@ -242,7 +242,7 @@ The message is @samp{Cannot determine image type}. @xref{Images}. @item inhibited-interaction The message is @samp{User interaction while inhibited}. This error is -signalled when @code{inhibit-interaction} is non-@code{nil} and a user +signaled when @code{inhibit-interaction} is non-@code{nil} and a user interaction function (like @code{read-from-minibuffer}) is called. @end table diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi index 7ffde7d43d1..9d5a2661916 100644 --- a/doc/lispref/functions.texi +++ b/doc/lispref/functions.texi @@ -734,7 +734,7 @@ a list of symbols representing the function alias chain, else @result{} (b c) @end example -If there's a loop in the definitions, an error will be signalled. If +If there's a loop in the definitions, an error will be signaled. If @var{noerror} is non-@code{nil}, the non-looping parts of the chain is returned instead. @end defun diff --git a/doc/lispref/help.texi b/doc/lispref/help.texi index 65ad5f05542..ee6fdb0dbbc 100644 --- a/doc/lispref/help.texi +++ b/doc/lispref/help.texi @@ -980,8 +980,8 @@ In addition to function descriptions, the list can also have string elements, which are used to divide a documentation group into sections. -@defun shortdoc-add-function shortdoc-add-function group section elem -Lisp packages can add functions to groups with this command. Each +@defun shortdoc-add-function group section elem +Lisp packages can add functions to groups with this function. Each @var{elem} should be a function description, as described above. @var{group} is the function group, and @var{section} is what section in the function group to insert the function into. diff --git a/doc/lispref/internals.texi b/doc/lispref/internals.texi index ea1679f6934..4640b6d7591 100644 --- a/doc/lispref/internals.texi +++ b/doc/lispref/internals.texi @@ -554,12 +554,17 @@ trigger another garbage collection. You can use the result returned by object type; space allocated to the contents of buffers does not count. The initial threshold value is @code{GC_DEFAULT_THRESHOLD}, defined in -@file{alloc.c}. Since it's defined in @code{word_size} units, the value -is 400,000 for the default 32-bit configuration and 800,000 for the 64-bit -one. If you specify a larger value, garbage collection will happen less -often. This reduces the amount of time spent garbage collecting, but -increases total memory use. You may want to do this when running a program -that creates lots of Lisp data. +@file{alloc.c}. Since it's defined in @code{word_size} units, the +value is 400,000 for the default 32-bit configuration and 800,000 for +the 64-bit one. If you specify a larger value, garbage collection +will happen less often. This reduces the amount of time spent garbage +collecting, but increases total memory use. You may want to do this +when running a program that creates lots of Lisp data. However, we +recommend against increasing the threshold for prolonged periods of +time, and advise that you never set it higher than needed for the +program to run in reasonable time. Using thresholds higher than +necessary could potentially cause system-wide memory pressure, and +should therefore be avoided. You can make collections more frequent by specifying a smaller value, down to 1/10th of @code{GC_DEFAULT_THRESHOLD}. A value less than this minimum @@ -576,6 +581,9 @@ garbage collection occurs only when both criteria are satisfied. As the heap size increases, the time to perform a garbage collection increases. Thus, it can be desirable to do them less frequently in proportion. + +As with @code{gc-cons-threshold}, do not enlarge this more than +necessary, and never for prolonged periods of time. @end defopt Control over the garbage collector via @code{gc-cons-threshold} and diff --git a/doc/lispref/intro.texi b/doc/lispref/intro.texi index 975215d6976..eccc8deb63c 100644 --- a/doc/lispref/intro.texi +++ b/doc/lispref/intro.texi @@ -34,7 +34,9 @@ specifically to editing. This is @iftex +@ifset VERSION edition @value{VERSION} of +@end ifset @end iftex the @cite{GNU Emacs Lisp Reference Manual}, corresponding to Emacs version @value{EMACSVER}. diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi index 089ae41f32e..332a453619c 100644 --- a/doc/lispref/minibuf.texi +++ b/doc/lispref/minibuf.texi @@ -2745,7 +2745,7 @@ Here's a typical use case: If @code{my-client-handling-function} ends up calling something that asks the user for something (via @code{y-or-n-p} or @code{read-from-minibuffer} or the like), an -@code{inhibited-interaction} error is signalled instead. The server +@code{inhibited-interaction} error is signaled instead. The server code then catches that error and reports it to the client. @node Minibuffer Misc diff --git a/doc/misc/ChangeLog.1 b/doc/misc/ChangeLog.1 index 1ee3c14fb9e..1c5e7c1e2fd 100644 --- a/doc/misc/ChangeLog.1 +++ b/doc/misc/ChangeLog.1 @@ -1460,7 +1460,7 @@ 2013-10-24 Michael Albinus <michael.albinus@gmx.de> - * ert.texi (Running Tests Interactively): Adapt examle output. + * ert.texi (Running Tests Interactively): Adapt example output. (Tests and Their Environment): Mention skip-unless. 2013-10-23 Glenn Morris <rgm@gnu.org> @@ -3525,7 +3525,7 @@ 2012-01-03 Carsten Dominik <carsten.dominik@gmail.com> - * org.texi (The clock table): Mention that ACHIVED trees + * org.texi (The clock table): Mention that ARCHIVED trees contribute to the clock table. 2012-01-03 Carsten Dominik <carsten.dominik@gmail.com> (tiny change) @@ -4420,12 +4420,7 @@ 2011-02-05 Era Eriksson <era+tramp@iki.fi> (tiny change) - * tramp.texi: - Replace "delimet" with "delimit" globally. - Replace "explicite" with "explicit" globally. - Replace "instead of" with "instead" where there was nothing after "of". - Audit use of comma before interrogative pronoun, "that", or "which". - Minor word order, spelling, wording changes. + * tramp.texi: Minor word order, spelling, wording changes. 2011-02-04 Teodor Zlatanov <tzz@lifelogs.com> @@ -5868,7 +5863,7 @@ 2009-09-02 Carsten Dominik <carsten.dominik@gmail.com> * org.texi (Effort estimates): Document new effort setting commands. - (Agenda commands): Document the new keys fro agenda time motion. + (Agenda commands): Document the new keys for agenda time motion. Document entry text mode. Improve documentation of the keys to include inactive time stamps into the agenda view. (Feedback): Document the new bug report command. @@ -10409,7 +10404,7 @@ * sc.texi (Emacs 18 MUAs): * speedbar.texi (Top): * url.texi (History): - Delete duplicate duplicate words. + Delete duplicate words. 2005-07-16 Johan Bockgård <bojohan@users.sourceforge.net> (tiny change) diff --git a/doc/misc/Makefile.in b/doc/misc/Makefile.in index b6eef7ea799..a7dbbbb48fe 100644 --- a/doc/misc/Makefile.in +++ b/doc/misc/Makefile.in @@ -68,13 +68,13 @@ DOCMISC_W32 = @DOCMISC_W32@ ## Info files to build and install on all platforms. INFO_COMMON = auth autotype bovine calc ccmode cl \ - dbus dired-x ebrowse ede ediff edt eglot eieio \ - emacs-mime epa erc ert eshell eudc efaq eww \ - flymake forms gnus emacs-gnutls htmlfontify idlwave ido info.info \ - mairix-el message mh-e modus-themes newsticker nxml-mode octave-mode \ - org pcl-cvs pgg rcirc remember reftex sasl \ - sc semantic ses sieve smtpmail speedbar srecode todo-mode transient \ - tramp url vhdl-mode vip viper vtable widget wisent woman + dbus dired-x ebrowse ede ediff edt efaq eglot eieio \ + emacs-gnutls emacs-mime epa erc ert eshell eudc eww \ + flymake forms gnus htmlfontify idlwave ido info.info \ + mairix-el message mh-e modus-themes newsticker nxml-mode \ + octave-mode org pcl-cvs pgg rcirc reftex remember sasl \ + sc semantic ses sieve smtpmail speedbar srecode todo-mode \ + tramp transient url vhdl-mode vip viper vtable widget wisent woman ## Info files to install on current platform. INFO_INSTALL = $(INFO_COMMON) $(DOCMISC_W32) diff --git a/doc/misc/auth.texi b/doc/misc/auth.texi index 9dc63af6bcc..872e5f88f55 100644 --- a/doc/misc/auth.texi +++ b/doc/misc/auth.texi @@ -526,6 +526,8 @@ If several entries match, the one matching the most items (where an while searching for an entry matching the @code{rms} user on host @code{gnu.org} and port @code{22}, then the entry @file{gnu.org:22/rms.gpg} is preferred over @file{gnu.org.gpg}. +However, such processing is not applied when the option +@code{auth-source-pass-extra-parameters} is set to @code{t}. Users of @code{pass} may also be interested in functionality provided by other Emacs packages: @@ -549,6 +551,22 @@ Set this variable to a string that should separate an host name from a port in an entry. Defaults to @samp{:}. @end defvar +@defvar auth-source-pass-extra-query-keywords +This expands the selection of available keywords to include +@code{:max} and @code{:require} and tells more of them to accept a +list of query parameters as an argument. When searching, it also +favors the @samp{rms@@gnu.org.gpg} form for usernames over the +@samp{gnu.org/rms.gpg} form, regardless of whether a @code{:user} +param was provided. + +In general, if you prefer idiosyncrasies traditionally exhibited by +this backend, such as prioritizing field count in a filename, try +setting this option to @code{nil}. But, if you experience problems +predicting the outcome of searches relative to other auth-source +backends or encounter code expecting to query multiple backends +uniformly, try flipping it back to @code{t} (the default). +@end defvar + @node Help for developers @chapter Help for developers diff --git a/doc/misc/ede.texi b/doc/misc/ede.texi index 7a26fe0e57a..0463d068c22 100644 --- a/doc/misc/ede.texi +++ b/doc/misc/ede.texi @@ -2536,7 +2536,7 @@ Call this when a user finishes customizing @var{TARGET}. @end deffn @deffn Method project-edit-file-target :AFTER ot -Edit the target @var{OT} associated w/ this file. +Edit the target @var{OT} associated with this file. @end deffn @deffn Method ede-documentation :AFTER this @@ -3563,7 +3563,7 @@ Run the current project in the debugger. @end deffn @deffn Method project-edit-file-target :AFTER obj -Edit the target associated w/ this file. +Edit the target associated with this file. @end deffn @node project-am-objectcode diff --git a/doc/misc/efaq.texi b/doc/misc/efaq.texi index 23e3b086a3a..3f5c2bc1a73 100644 --- a/doc/misc/efaq.texi +++ b/doc/misc/efaq.texi @@ -2668,7 +2668,7 @@ To disable or change the way backups are made, @cindex Backup files in a single directory You can control where Emacs puts backup files by customizing the variable @code{backup-directory-alist}. This variable's value -specifies that files whose names match specific patters should have +specifies that files whose names match specific patterns should have their backups put in certain directories. A typical use is to add the element @code{("." . @var{dir})} to force Emacs to put @strong{all} backup files in the directory @file{dir}. diff --git a/doc/misc/eglot.texi b/doc/misc/eglot.texi index 8d184976cde..04bdcc61614 100644 --- a/doc/misc/eglot.texi +++ b/doc/misc/eglot.texi @@ -264,8 +264,9 @@ Emacs major-mode @code{foo-mode}, you can add it to the alist like this: @lisp -(add-to-list 'eglot-server-programs - '(foo-mode . ("fools" "--stdio"))) +(with-eval-after-load 'eglot + (add-to-list 'eglot-server-programs + '(foo-mode . ("fools" "--stdio")))) @end lisp This will invoke the program @command{fools} with the command-line @@ -277,6 +278,24 @@ mentioned by the @code{exec-path} variable (@pxref{Subprocess Creation,,, elisp, GNU Emacs Lisp Reference Manual}), for Eglot to be able to find it. +Sometimes, multiple servers are acceptable alternatives for handling a +given major-mode. In those cases, you may combine the helper function +@code{eglot-alternatives} with the funcional form of +@code{eglot-server-programs}. + +@lisp +(with-eval-after-load 'eglot + (add-to-list 'eglot-server-programs + `(foo-mode . ,(eglot-alternatives + '(("fools" "--stdio") + ("phewls" "--fast")))))) +@end lisp + +If you have @command{fools} and @command{phewls} installed, the +function produced by @code{eglot-alternatives} will prompt for the +server to use in @code{foo-mode} buffers. Else it will use whichever +is available. + @node Starting Eglot @section Starting Eglot @cindex starting Eglot @@ -1046,8 +1065,10 @@ Eglot via Elisp to adapt to it, by defining a suitable Here's an example: @lisp +(require 'eglot) + (add-to-list 'eglot-server-programs - '((c++ mode c-mode) . (eglot-cquery "cquery"))) + '((c++-mode c-mode) . (eglot-cquery "cquery"))) (defclass eglot-cquery (eglot-lsp-server) () :documentation "A custom class for cquery's C/C++ langserver.") diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi index 3db83197f9e..0d807e323e6 100644 --- a/doc/misc/erc.texi +++ b/doc/misc/erc.texi @@ -79,6 +79,7 @@ Advanced Usage * Connecting:: Ways of connecting to an IRC server. * Sample Configuration:: An example configuration file. +* Integrations:: Integrations available for ERC. * Options:: Options that are available for ERC. @end detailmenu @@ -526,6 +527,7 @@ Translate morse code in messages @menu * Connecting:: Ways of connecting to an IRC server. * Sample Configuration:: An example configuration file. +* Integrations:: Integrations available for ERC. * Options:: Options that are available for ERC. @end menu @@ -861,7 +863,8 @@ The default value for all three options is the function @code{erc-auth-source-search}. It tries to merge relevant contextual parameters with those provided or discovered from the logical connection or the underlying transport. Some auth-source back ends may not be -compatible; netrc, plstore, json, and secrets are currently supported. +compatible; netrc, plstore, json, secrets, and pass are currently +supported. @end defopt @subheading Full name @@ -990,6 +993,32 @@ stuff, to the current ERC buffer." ;; (setq erc-kill-server-buffer-on-quit t) @end lisp +@node Integrations +@section Integrations +@cindex integrations + +@subheading URL +For anything to work, you'll want to set @code{url-irc-function} to +@code{url-irc-erc}. As a rule of thumb, libraries relying directly on +@code{url-retrieve} should be fine out the box from Emacs 29.1 onward. +On older versions of Emacs, you may need to @code{(require 'erc)} +beforehand. @pxref{Retrieving URLs,,, url, URL}. + +For other apps and libraries, such as those relying on the +higher-level @code{browse-url}, you'll oftentimes be asked to specify +a pattern, sometimes paired with a function that accepts a string URL +as a first argument. For example, with EWW, you may need to tack +something like @code{"\\|\\`irc6?s?:"} onto the end of +@code{eww-use-browse-url}. But with @code{gnus-button-alist}, you'll +need a function as well: + +@lisp + '("\\birc6?s?://[][a-z0-9.,@@_:+%?&/#-]+" 0 t browse-url-irc 0) +@end lisp + +@noindent +Users on Emacs 28 and below may need to use @code{browse-url} instead. + @node Options @section Options @cindex options diff --git a/doc/misc/eshell.texi b/doc/misc/eshell.texi index 96873a3f9a5..e6ddcf11dfa 100644 --- a/doc/misc/eshell.texi +++ b/doc/misc/eshell.texi @@ -1126,7 +1126,7 @@ Repeatedly evaluate @var{commands} until @var{conditional} is satisfied. @item for @var{var} in @var{list}@dots{} @{ @var{commands} @} -Iterate over each element of of @var{list}, storing the element in +Iterate over each element of @var{list}, storing the element in @var{var} and evaluating @var{commands}. If @var{list} is not a list, treat it as a list of one element. If you specify multiple @var{lists}, this will iterate over each of them in turn. diff --git a/doc/misc/eudc.texi b/doc/misc/eudc.texi index 50e483057d3..0e1ff67c1fd 100644 --- a/doc/misc/eudc.texi +++ b/doc/misc/eudc.texi @@ -85,6 +85,10 @@ LDAP, Lightweight Directory Access Protocol BBDB, Big Brother's Insidious Database @item macOS Contacts +@item +@code{ecomplete}, Emacs's electrical completion +@item +@code{mailabbrev}, Emacs's abbrev-expansion of mail aliases @end itemize The main features of the EUDC interface are: @@ -110,6 +114,8 @@ Interface to BBDB to let you insert server records into your own BBDB database * LDAP:: What is LDAP ? * BBDB:: What is BBDB ? * macOS Contacts:: What is macOS Contacts ? +* ecomplete:: What is @code{ecomplete} ? +* mailabbrev:: What is @code{mailabbrev}? @end menu @@ -173,14 +179,73 @@ Address Book; the EUDC macOS Contacts back end also works on those older versions. +@node ecomplete +@section @code{ecomplete} + +@code{ecomplete} is Emacs's ``electric completion'', and it is part of +Emacs. It stores all information in an @file{ecompleterc} file, whose +location, and name can be configured via the variable +@code{ecomplete-database-file} (which see). The format of the file +is: + +@display +((TYPE_1 ITEM_1 ITEM_2 ...) + (TYPE_2 ITEM_N+1 ITEM_N+2 ...) + ...) +@end display + +That is, it is an alist map where the key is the type of match (so +that you can have one list of things for ``mail'', and one for, say, +``mastodon''). In each of these sections you then have a list where +each item is of the form: + +@display +(KEY TIMES-USED LAST-TIME-USED STRING) +@end display + +When performing a query, the result will be all items where the search +term matches all, or part of STRING. + +When EUDC performs queries with @code{ecomplete}, the name of each +attribute making up the query is used as the type in which the lookup +is performed. The mapping from EUDC attribute names to +@code{ecomplete} type names is performed according to the variable +@code{eudc-ecomplete-attributes-translation-alist} (which see). + + +@node mailabbrev +@section @code{mailabbrev} + +@code{mailabbrev} is Emacs's ``abbrev-expansion of mail aliases'', and +it is part of Emacs. It stores all information in a @file{mailrc} +file, whose location, and name can be configured via the variable +@code{mail-personal-alias-file} (which see). The @file{mailrc} file +has the same format as the @command{mail} and @command{mailx} commands +use for their startup configuration file. @code{mailabbrev} processes +@samp{alias}, and @samp{source} statements in the @file{mailrc} file. +@samp{alias} statements can define simple aliases and distribution +lists, and can be nested in that the alias expansion can contain +references to other alias definitions. Forward references, that is +references to aliases before they are actually defined, are possible, +too. + +Originally, @code{mailabbrev} was designed to be used with +@code{abbrev-mode}. The @code{mailabbrev} EUDC backend does not use +@code{abbrev-mode}, but queries @code{mailabbrev} for alias entries +only, and returns these as EUDC results. All entries where the alias +name exactly equals either the @code{email}, @code{name}, or +@code{firstname} attribute value in the EUDC query, will be returned +as matches. When a @file{mailrc} alias defines a distribution list, +that is it expands to more than one email address, the EUDC result +will contain a single entry, which will contain an email attribute +only, whose value will be a comma-separated list of RFC 5322 formatted +recipient specifications. + + @node Installation @chapter Installation -Add the following to your @file{.emacs} init file: -@lisp -(require 'eudc) -@end lisp -This will install EUDC at startup. +EUDC is built-in to Emacs, and its main functions are autoloaded. After installing EUDC you will find (the next time you launch Emacs) a new @code{Directory Search} submenu in the @samp{Tools} menu that will @@ -200,6 +265,8 @@ email composition buffers (@pxref{Inline Query Expansion}) @menu * LDAP Configuration:: EUDC needs external support for LDAP * macOS Contacts Configuration:: Enable the macOS Contacts backend +* ecomplete Configuration:: Enable the ecomplete backend +* mailabbrev Configuration:: Enable the mailabbrev backend @end menu @node LDAP Configuration @@ -256,7 +323,7 @@ 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, except if the word corresponds to an attribute which is a member of -`eudc-ldap-no-wildcard-attributes'. +@code{eudc-ldap-no-wildcard-attributes}. @menu * Emacs-only Configuration:: Configure with @file{.emacs} @@ -406,9 +473,9 @@ level to 5 by appending @code{-d 5} to the command line. macOS Contacts support is added by means of @file{eudcb-mab.el}, or @file{eudcb-macos-contacts.el} which are part of Emacs. -To enable a macOS Contacts backend, first `require' the respective -library to load it, and then set the `eudc-server' to localhost in -your init file: +To enable a macOS Contacts backend, first @code{require} the +respective library to load it, and then set the @code{eudc-server} to +localhost in your init file: @lisp (require 'eudcb-macos-contacts) (eudc-macos-contacts-set-server "localhost") @@ -433,6 +500,32 @@ command-line utility before upgrading to a new version of macOS. existing configurations, and may be removed in a future release. +@node ecomplete Configuration +@section @code{ecomplete} Configuration + +@code{ecomplete} is Emacs's ``electrical completion'', and is part of +Emacs. To use it, you will need to set up a database file +(@pxref{ecomplete}) first. + +It will be autoloaded on demand. + +You can also enable multi-server queries as described in +@pxref{Multi-server Queries}. + + +@node mailabbrev Configuration +@section @code{mailabbrev} Configuration + +@code{mailabbrev} is Emacs's ``abbrev-expansion of mail aliases'', and +it is part of Emacs. To use it, you will need to set up a database file +(@pxref{mailabbrev}) first. + +It will be autoloaded on demand. + +You can also enable multi-server queries as described in +@pxref{Multi-server Queries}. + + @node Usage @chapter Usage diff --git a/doc/misc/flymake.texi b/doc/misc/flymake.texi index da1695099a2..4561b760c04 100644 --- a/doc/misc/flymake.texi +++ b/doc/misc/flymake.texi @@ -615,7 +615,7 @@ delimited by @var{beg} and @var{end}. @var{type} is a diagnostic symbol (@pxref{Flymake error types}), and @var{text} is a description of the problem detected in this region. Most commonly @var{locus} is the buffer object designating for the current buffer being -syntax-checked. However, it may be a string nameing a file relative +syntax-checked. However, it may be a string naming a file relative to the current working directory. @xref{Foreign and list-only diagnostics}, for when this may be useful. Depending on the type of @var{locus}, @var{beg} and @var{end} are both either buffer positions @@ -844,8 +844,8 @@ Binding,,, elisp, The Emacs Lisp Reference Manual}) to be active. * Interaction with other modes:: @end menu -@findex flymake-proc-legacy-backend -The backend @code{flymake-proc-legacy-backend} was originally designed +@findex flymake-proc-legacy-flymake +The backend @code{flymake-proc-legacy-flymake} was originally designed to be extended for supporting new syntax check tools and error message patterns. It is also controlled by its own set of customization variables @@ -1053,7 +1053,7 @@ check-syntax: @cindex syntax check models @cindex master file -@code{flymake-proc-legacy-backend} saves a copy of the buffer in a +@code{flymake-proc-legacy-flymake} saves a copy of the buffer in a temporary file in the buffer's directory (or in the system temporary directory, for Java files), creates a syntax check command and launches a process with this command. The output is parsed using a diff --git a/doc/misc/gnus.texi b/doc/misc/gnus.texi index 7bcf3342977..c4705928d33 100644 --- a/doc/misc/gnus.texi +++ b/doc/misc/gnus.texi @@ -21592,11 +21592,10 @@ details on Gnus' query language, see @ref{Search Queries}. In order to search for messages from any given server, that server must have a search engine associated with it. IMAP servers do their -own searching (theoretically it is possible to use a different engine -to search an IMAP store, but we don't recommend it), but in all other -cases the user will have to manually specify an engine to use. This -can be done at two different levels: by server type, or on a -per-server basis. +own searching, and searching IMAP groups will work with no additional +configuration, but in all other cases the user will have to manually +specify an engine to use. This can be done at two different levels: +by server type, or on a per-server basis. @vindex gnus-search-default-engines The option @code{gnus-search-default-engines} assigns search engines @@ -21900,14 +21899,13 @@ be found at @uref{http://www.rpcurnow.force9.co.uk/mairix/index.html} Though mairix might not be as flexible as other search tools like -swish++ or namazu, which you can use via the @code{nnir} back end, it -has the prime advantage of being incredibly fast. On current systems, it -can easily search through headers and message bodies of thousands and -thousands of mails in well under a second. Building the database -necessary for searching might take a minute or two, but only has to be -done once fully. Afterwards, the updates are done incrementally and -therefore are really fast, too. Additionally, mairix is very easy to set -up. +swish++ or namazu, it has the prime advantage of being incredibly +fast. On current systems, it can easily search through headers and +message bodies of thousands and thousands of mails in well under a +second. Building the database necessary for searching might take a +minute or two, but only has to be done once fully. Afterwards, the +updates are done incrementally and therefore are really fast, too. +Additionally, mairix is very easy to set up. For maximum speed though, mairix should be used with mails stored in @code{Maildir} or @code{MH} format (this includes the @code{nnml} back @@ -22545,6 +22543,21 @@ to you, using @kbd{G b u} and updating the group will usually fix this. @end itemize +@node nnir +@section Migrating from nnir + +@cindex nnir + +Gnus' previous search engine was called nnir, and is obsolete as of +Emacs version 28. If you've upgraded Emacs and are now getting +obsolete-variable warnings about @code{nnir-*} variables, migration is +fairly straightforward. In addition to the variables raised by the +warnings, all previous engine-specific variables can be updated by +simply replacing the @code{nnir-} prefix with @code{gnus-search-}. +For instance, @code{nnir-notmuch-program} is now +@code{gnus-search-notmuch-program}. + + @iftex @iflatex @chapter Message diff --git a/doc/misc/message.texi b/doc/misc/message.texi index 6a6beb7a1ff..cfad4f4e07e 100644 --- a/doc/misc/message.texi +++ b/doc/misc/message.texi @@ -1005,7 +1005,7 @@ that they can deposit messages and lock the door, while your private key corresponds to the opening combination for the safe.) Thus, you need to perform the following steps for e-mail encryption, -typically outside Emacs. See, for example, the +typically outside Emacs. See, for example, @uref{https://www.gnupg.org/gph/en/manual.html, The GNU Privacy Handbook} for details covering the standard @acronym{OpenPGP} with @acronym{GnuPG}. diff --git a/doc/misc/modus-themes.org b/doc/misc/modus-themes.org index c5accd0789d..db92dfb4817 100644 --- a/doc/misc/modus-themes.org +++ b/doc/misc/modus-themes.org @@ -2834,7 +2834,7 @@ To reset the changes, we apply this and reload the theme: Users who wish to leverage such a mechanism can opt to implement it on-demand by means of a global minor mode. The following snippet covers -both themes and expands to some more assosiations in the palette: +both themes and expands to some more associations in the palette: #+begin_src emacs-lisp (define-minor-mode my-modus-themes-tinted @@ -3649,7 +3649,7 @@ specification of that variable looks like this: With the exception of ~org-verbatim~ and ~org-code~ faces, everything else uses the corresponding type of emphasis: a bold typographic weight, or -italicised, underlined, and struck through text. +italicized, underlined, and struck through text. The best way for users to add some extra attributes, such as a foreground color, is to define their own faces and assign them to the @@ -5878,7 +5878,7 @@ interface virtually unusable. [[#h:5808be52-361a-4d18-88fd-90129d206f9b][Option for links]]. -Again, one must exercise judgement in order to avoid discrimination, +Again, one must exercise judgment in order to avoid discrimination, where "discrimination" refers to: + The treatment of substantially different magnitudes as if they were of @@ -5951,7 +5951,7 @@ the themes, which is partially fleshed out in this manual. With regard to the artistic aspect (where "art" qua skill may amount to an imprecise science), there is no hard-and-fast rule in effect as it -requires one to exercize discretion and make decisions based on +requires one to exercise discretion and make decisions based on context-dependent information or constraints. As is true with most things in life, when in doubt, do not cling on to the letter of the law but try to understand its spirit. diff --git a/doc/misc/org.org b/doc/misc/org.org index ae3ca0b64f3..6ad8c462cc3 100644 --- a/doc/misc/org.org +++ b/doc/misc/org.org @@ -16569,7 +16569,7 @@ identifying a reference in the bibliography. - Each key can be qualified by a /prefix/ (e.g.\nbsp{}"see ") and/or a /suffix/ (e.g.\nbsp{}"p.\nbsp{}123"), giving information useful or necessary - fo the comprehension of the citation but not included in the + for the comprehension of the citation but not included in the reference. - A single citation can cite more than one reference ; the keys are diff --git a/doc/misc/reftex.texi b/doc/misc/reftex.texi index b30e5aeaa4d..9c543a4c0fb 100644 --- a/doc/misc/reftex.texi +++ b/doc/misc/reftex.texi @@ -3605,7 +3605,7 @@ menu. @xref{Key Bindings}. @deffn Command reftex-toc Show the table of contents for the current document. When called with -one ore two @kbd{C-u} prefixes, rescan the document first. +one or two @kbd{C-u} prefixes, rescan the document first. @end deffn @deffn Command reftex-label @@ -5292,7 +5292,7 @@ Some improvements for XEmacs compatibility. @itemize @bullet @item Fixed bug with @samp{%F} in a label prefix. Added new escapes -@samp{%m} and @samp{%M} for mater file name and master directory. +@samp{%m} and @samp{%M} for master file name and master directory. @end itemize @noindent @b{Version 4.24} diff --git a/doc/misc/ses.texi b/doc/misc/ses.texi index 6d0415cdbbb..e3ef11ebc02 100644 --- a/doc/misc/ses.texi +++ b/doc/misc/ses.texi @@ -750,13 +750,13 @@ when you pass a cell name to the @command{ses-jump} command (@kbd{j}), it changes the entered cell name to that where to jump. The default setting @code{upcase} allows you to enter the cell name in low case. Another use of @code{ses-jump-cell-name-function} could be some -internationalisation to convert non latin characters into latin +internationalization to convert non latin characters into latin equivalents to name the cell. Instead of a cell name, the function may return cell coordinates in the form of a cons, for instance @code{(0 . 0)} for cell @code{A1}, @code{(1 . 0)} for cell @code{A2}, etc. @vindex ses-jump-prefix-function -@code{ses-jump-prefix-function} is a customisable variable by default +@code{ses-jump-prefix-function} is a customizable variable by default set to the @code{ses-jump-prefix} function. This function is called when you give a prefix argument to the @command{ses-jump} command (@kbd{j}). It returns a cell name or cell coordinates corresponding to diff --git a/doc/misc/srecode.texi b/doc/misc/srecode.texi index a0cbf7e33fb..d7356fef58a 100644 --- a/doc/misc/srecode.texi +++ b/doc/misc/srecode.texi @@ -1595,7 +1595,7 @@ from a user perspective during basic interactive insertion via NOTES ON THIS CHAPTER: -These conventions are being worked on. Check w/ CEDET-DEVEL mailing +These conventions are being worked on. Check with CEDET-DEVEL mailing list if you want to support a language, or write an application and provide your opinions on this topic. Any help is appreciated. diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 99a268367b8..403c0daa67b 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -4225,7 +4225,7 @@ non-@code{nil}, or invoke that command with a negative argument like @value{tramp}'s implementation of @code{make-process} and @code{start-file-process} requires a serious overhead for initialization, every process invocation. This is needed for handling -interactive dialogues when connecting the remote host (like providing +interactive dialogs when connecting the remote host (like providing a password), and initial environment setup. Sometimes, this is not needed. Instead of starting a remote shell and @@ -4253,8 +4253,9 @@ Furthermore, this approach has the following limitations: @itemize @item -It works only for connection methods defined in @file{tramp-adb.el}, -@file{tramp-sh.el} and @file{tramp-sshfs.el}. +It works only for some connection methods defined in +@file{tramp-adb.el}, @file{tramp-container.el}, @file{tramp-sh.el} and +@file{tramp-sshfs.el}. @item It does not support interactive user authentication. With diff --git a/doc/misc/transient.texi b/doc/misc/transient.texi index a6745131d88..e5e7cccbe8d 100644 --- a/doc/misc/transient.texi +++ b/doc/misc/transient.texi @@ -1957,7 +1957,7 @@ probably don't want that. @item @code{transient-suffix} and @code{transient-non-suffix} play a part when determining whether the currently active transient prefix command -remains active/transient when a suffix or abitrary non-suffix +remains active/transient when a suffix or arbitrary non-suffix command is invoked. @xref{Transient State}. @item diff --git a/doc/misc/vip.texi b/doc/misc/vip.texi index df65d70cb1b..8e192d7e400 100644 --- a/doc/misc/vip.texi +++ b/doc/misc/vip.texi @@ -1203,11 +1203,11 @@ Move point backward to the character @var{ch} on the line. Signal error if @var{ch} could not be found (@code{vip-find-char-backward}). @item t @var{ch} @kindex 164 t @r{(}@code{vip-goto-char-forward}@r{)} -Move point forward upto the character @var{ch} on the line. Signal error if +Move point forward up to the character @var{ch} on the line. Signal error if @var{ch} could not be found (@code{vip-goto-char-forward}). @item T @var{ch} @kindex 124 T @r{(}@code{vip-goto-char-backward}@r{)} -Move point backward upto the character @var{ch} on the line. Signal error if +Move point backward up to the character @var{ch} on the line. Signal error if @var{ch} could not be found (@code{vip-goto-char-backward}). @item ; @kindex 073 ; @r{(}@code{vip-repeat-find}@r{)} diff --git a/etc/ERC-NEWS b/etc/ERC-NEWS index 5cabb9b015c..f638d4717a1 100644 --- a/etc/ERC-NEWS +++ b/etc/ERC-NEWS @@ -77,6 +77,13 @@ blanks when 'erc-send-whitespace-lines' is active. New options have also been added for warning when input spans multiple lines. Although off by default, new users are encouraged to enable them. +** URL handling has improved. +Clicking on 'irc://' and 'ircs://' links elsewhere in Emacs now does +the right thing most of the time. However, for security reasons, +users are now prompted to confirm connection parameters prior to lift +off. See the new '(erc) Integrations' section in the Info manual to +override this. + ** Miscellaneous behavioral changes impacting the user experience. A bug has been fixed that saw prompts being mangled, doubled, or erased in server buffers upon disconnection. Instead, input prompts @@ -112,7 +112,8 @@ efficient than the original one, and should speed up all the operations that involve overlays, especially when there are lots of them in a buffer. However, no changes in behavior of overlays should be visible on the Lisp or user level, with the exception of better -performance. +performance and the order of overlays returned by functions that don't +promise any particular order. --- ** The docstrings of preloaded files are not in "etc/DOC" any more. @@ -164,7 +165,7 @@ time. +++ *** New variable 'inhibit-automatic-native-compilation'. If set, Emacs will inhibit native compilation (and won't write -anything to the eln cache automatically). The variable is initialised +anything to the eln cache automatically). The variable is initialized from the 'EMACS_INHIBIT_AUTOMATIC_NATIVE_COMPILATION' environment variable on Emacs startup. @@ -439,6 +440,12 @@ The user options 'url-gateway-rlogin-host', are also obsolete. --- +** The user function 'url-irc-function' now takes a 'scheme' argument. +The user option 'url-irc-function' is now called with a sixth argument +corresponding to the scheme portion of the target URL. For example, +this would be "ircs" for a URL like "ircs://irc.libera.chat". + +--- ** The linum.el library is now obsolete. We recommend using either the built-in 'display-line-numbers-mode', or the 'nlinum' package from GNU ELPA instead. The former has better @@ -711,6 +718,15 @@ part of the buffer. +++ ** 'count-words' will now report sentence count when used interactively. +** New user option 'set-message-functions'. +It allows selecting more functions for 'set-message-function' +in addition to the default function that handles messages +in the active minibuffer. The most useful are 'inhibit-message' +that allows specifying a list of messages to inhibit via +'inhibit-message-regexps', and 'set-multi-message' that +accumulates recent messages and displays them stacked +in the echo area. + --- ** New user option 'find-library-include-other-files'. If set to nil, commands like 'find-library' will only include library @@ -1385,6 +1401,14 @@ If non-nil and there's only one matching option, auto-select that. If non-nil, this user option describes what entries not to add to the database stored on disk. +** Auth-Source + ++++ +*** New user option 'auth-source-pass-extra-query-keywords'. +Whether to recognize additional keyword params, like ':max' and +':require', as well as accept lists of query terms paired with +applicable keywords. + ** Dired +++ @@ -1440,8 +1464,8 @@ This command visits the file on the current line with EWW. ** Elisp --- -*** New command 'elisp-eval-buffer' (bound to 'C-c C-e'). -This command evals the forms in the current buffer. +*** New command 'elisp-eval-region-or-buffer' (bound to 'C-c C-e'). +This command evals the forms in the active region or in the whole buffer. --- *** New commands 'elisp-byte-compile-file' and 'elisp-byte-compile-buffer'. @@ -1481,6 +1505,10 @@ This controls how statements like the following are indented: It is enabled by default, but requires that the external "shellcheck" command is installed. +** CC Mode +--- +*** C++ Mode now supports most of the new features in the C++20 standard. + ** Cperl Mode --- @@ -1587,7 +1615,7 @@ package maintainers. +++ *** New user option 'package-vc-selected-packages' -By customising this user option you can specify specific packages to +By customizing this user option you can specify specific packages to install. ** Emacs Sessions (Desktop) @@ -2017,6 +2045,18 @@ The EUDC back-end for the macOS Contacts app now provides a wider set of attributes to use for queries, and delivers more attributes in query results. ++++ +*** New back-end for ecomplete +A new back-end for ecomplete allows information from that database to +be queried by EUDC, too. The attributes present in the EUDC query are +used to select the entry type in the ecomplete database. + ++++ +*** New back-end for mailabbrev +A new back-end for mailabbrev allows information from that database to +be queried by EUDC, too. The attributes email, name, and firstname +are supported only. + ** EWW/SHR +++ @@ -2109,13 +2149,20 @@ The older form still works but is undocumented. --- *** Rmail partial summaries can now be applied one on top of the other. -You can now narrow the filtering of messages by the summary's criteria -(recipients, topic, senders, etc.) by making a summary of the already -summarized messages. For example, invoking 'rmail-summary-by-senders', -followed by 'rmail-summary-by-topic' will produce a summary where both -the senders and the topic are according to your selection. The new -user option 'rmail-summary-apply-filters-consecutively' controls -whether the stacking of the filters is in effect. +You can now narrow the set of messages selected by Rmail summary's +criteria (recipients, topic, senders, etc.) by making a summary of the +already summarized messages. For example, invoking +'rmail-summary-by-senders', followed by 'rmail-summary-by-topic' will +produce a summary where both the senders and the topic are according +to your selection. The new user option +'rmail-summary-progressively-narrow' controls whether the stacking of +the filters is in effect; customize it to a non-nil value to enable +this feature. + +--- +*** New Rmail summary: by thread. +The new command 'rmail-summary-by-thread' produces a summary of +messages that belong to a single thread of discussion. ** EIEIO @@ -2180,6 +2227,10 @@ it with new 'term-{faint,italic,slow-blink,fast-blink}' faces. a prefix argument which is interpreted to mean "include all files". +++ +*** New command 'project-list-buffers' bound to 'C-x p C-b'. +This command displays a list of buffers from the current project. + ++++ *** '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. @@ -2598,6 +2649,17 @@ related functions will use by default. For example, you could customize this to "https" to always prefer HTTPS URLs. --- +*** New user option 'browse-url-irc-function'. +This option specifies a function for opening irc:// links. It +defaults to the new function 'browse-url-irc'. + +--- +*** New function 'browse-url-irc'. +This multipurpose autoloaded function can be used for opening irc:// +and ircs:// URLS by any caller that passes a URL string as an initial +arg. + +--- *** Support for the Netscape web browser has been removed. This support has been obsolete since Emacs 25.1. The final version of the Netscape web browser was released in February, 2008. @@ -2824,6 +2886,9 @@ remote host are shown. Alternatively, the user option The old name is still available as an obsolete function alias. --- +*** The url-irc library now understands ircs:// links. + +--- *** New command 'world-clock-copy-time-as-kill' for 'M-x world-clock'. It copies the current line into the kill ring. @@ -2930,7 +2995,7 @@ normal. --- ** Themes have special autoload cookies. -All build-in themes are scraped for ';;;###theme-autoload' cookies +All built-in themes are scraped for ';;;###theme-autoload' cookies that are loaded along with the regular auto-loaded code. +++ @@ -4010,6 +4075,12 @@ This function allows defining a number of keystrokes with one form. ** New macro 'defvar-keymap'. This macro allows defining keymap variables more conveniently. +** 'defvar-keymap' can specify 'repeat-mode' behavior for the keymap. +Use ':repeat t' to have all bindings be repeatable or for more +advanced usage: + + ':repeat (:enter (commands ...) :exit (commands ...))' + --- ** 'kbd' can now be used in built-in, preloaded libraries. It no longer depends on edmacro.el and cl-lib.el. diff --git a/etc/NEWS.28 b/etc/NEWS.28 index 8eab05a7634..9982296aaab 100644 --- a/etc/NEWS.28 +++ b/etc/NEWS.28 @@ -2771,7 +2771,7 @@ If non-nil, it is a regexp that should match a valid cover image. *** '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. +*** fileloop will now skip missing files instead of signaling an error. *** 'tabulated-list-mode' can now restore original display order. Many commands (like 'C-x C-b') are derived from 'tabulated-list-mode', diff --git a/etc/NEXTSTEP b/etc/NEXTSTEP index dacbed20451..0570f707959 100644 --- a/etc/NEXTSTEP +++ b/etc/NEXTSTEP @@ -206,7 +206,7 @@ Release History keys, fix border and box drawing, remove glitches in modeline drawing, support overstrike for unavailable bold fonts, fix XPM - related crasher bugs. Incremental font + related crashes. Incremental font metrics caching and other performance improvements. Shared-lisp builds now possible. diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS index 3c164b1282f..3b6ab2e2adf 100644 --- a/etc/ORG-NEWS +++ b/etc/ORG-NEWS @@ -2847,7 +2847,7 @@ can pass the converted path to the =sqlcmd= tool. **** Improved support of header arguments for postgresql -The postgresql engine in a sql code block supports now ~:dbport~ nd +The postgresql engine in a sql code block now supports ~:dbport~ and ~:dbpassword~ as header arguments. **** Support for additional plantuml output formats @@ -5763,7 +5763,7 @@ that Calc formulas can operate on them. **** org-ctags.el (Paul Sexton) Targets like =<<my target>>= can now be found by Emacs' etag - functionality, and Org-mode links can be used to to link to + functionality, and Org-mode links can be used to link to etags, also in non-Org-mode files. For details, see the file /org-ctags.el/. @@ -6120,7 +6120,7 @@ that Calc formulas can operate on them. code that is actually evaluated comprises the code block contents, augmented with the extra code which assigns the referenced data to variables. It is now possible to preview expanded contents, and - also to expand code during during tangling. This expansion takes + also to expand code during tangling. This expansion takes into account all header arguments, and variables. A new keybinding `C-c M-b p' bound to `org-babel-expand-src-block' @@ -6235,7 +6235,7 @@ that Calc formulas can operate on them. **** Localized clock tables - Clock tables now support a new new =:lang= parameter, allowing + Clock tables now support a new =:lang= parameter, allowing the user to customize the localization of the table headers. See the variable =org-clock-clocktable-language-setup= which controls available translated strings. diff --git a/etc/PROBLEMS b/etc/PROBLEMS index aaecc41f6e8..2169ed0f80b 100644 --- a/etc/PROBLEMS +++ b/etc/PROBLEMS @@ -1640,16 +1640,21 @@ X expects to find it. *** Improving performance with slow X connections. -There are several ways to improve this performance, any subset of which can -be carried out at the same time: +There are several ways to improve this performance, any subset of +which can be carried out at the same time: -1) If you don't need X Input Methods (XIM) for entering text in some +1) Use the "--with-x-toolkit=no" build of Emacs. By not relying on + any toolkit (exhibiting potentially slow behavior), it has been + made very fast over networks exhibiting high latency, but suitable + bandwidth. + +2) If you don't need X Input Methods (XIM) for entering text in some language you use, you can improve performance on WAN links by using the X resource useXIM to turn off use of XIM. This does not affect the use of Emacs's own input methods, which are part of the Leim package. -2) If the connection is very slow, you might also want to consider +3) If the connection is very slow, you might also want to consider switching off scroll bars, menu bar, and tool bar. Adding the following forms to your .emacs file will accomplish that, but only after the initial frame is displayed: @@ -1665,26 +1670,45 @@ be carried out at the same time: Emacs.menuBar: off Emacs.toolBar: off -3) Use ssh to forward the X connection, and enable compression on this +4) Use ssh to forward the X connection, and enable compression on this forwarded X connection (ssh -XC remotehostname emacs ...). -4) Use lbxproxy on the remote end of the connection. This is an interface - to the low bandwidth X extension in most modern X servers, which - improves performance dramatically, at the slight expense of correctness - of the X protocol. lbxproxy achieves the performance gain by grouping - several X requests in one TCP packet and sending them off together, - instead of requiring a round-trip for each X request in a separate - packet. The switches that seem to work best for emacs are: - -noatomsfile -nowinattr -cheaterrors -cheatevents - Note that the -nograbcmap option is known to cause problems. - For more about lbxproxy, see: + Keep in mind that this does not help with latency problems, only + andwidth ones. + +5) Use lbxproxy on the remote end of the connection. This is an + interface to the low bandwidth X extension in some outdated X + servers, which improves performance dramatically, at the slight + expense of correctness of the X protocol. lbxproxy achieves the + performance gain by grouping several X requests in one TCP packet + and sending them off together, instead of requiring a round-trip + for each X request in a separate packet. The switches that seem to + work best for emacs are: -noatomsfile -nowinattr -cheaterrors + -cheatevents Note that the -nograbcmap option is known to cause + problems. For more about lbxproxy, see: http://www.x.org/archive/X11R6.8.0/doc/lbxproxy.1.html -5) If copying and killing is slow, try to disable the interaction with the + Keep in mind that lbxproxy and the LBX extension are now obsolete. + +6) If copying and killing is slow, try to disable the interaction with the native system's clipboard by adding these lines to your .emacs file: + (setq interprogram-cut-function nil) (setq interprogram-paste-function nil) +7) If selecting text with the mouse is slow, the main culprit is + likely `select-active-regions', coupled with a program monitoring + the clipboard on the X server you are connected to. Try turning + that off. + + However, over networks with moderate to high latency, with no + clipboard monitor running, the bottleneck is likely to be + `mouse-position' instead. Set the variable + `x-use-fast-mouse-position' to either any non-nil value, or to the + symbol `really-fast' if that is still too slow. Doing so will also + cause Emacs features that relies on accurate mouse position + reporting to stop working reliably. + *** Emacs gives the error, Couldn't find per display information. This can result if the X server runs out of memory because Emacs uses @@ -1770,7 +1770,7 @@ The MPX code has not been tested under X toolkit or GTK+ 2.x builds and is not expected to work there. ** Framework for doing animations -Emacs does animations all over the place, usually "pluse" animations. +Emacs does animations all over the place, usually "pulse" animations. These currently animate by waiting for a small but fixed amount of time between each redisplay, which causes screen tearing by not synchronizing with the vertical refresh. Frame synchronization works diff --git a/etc/themes/dichromacy-theme.el b/etc/themes/dichromacy-theme.el index fe44d520cca..c9d73983b59 100644 --- a/etc/themes/dichromacy-theme.el +++ b/etc/themes/dichromacy-theme.el @@ -39,7 +39,7 @@ Ansi-Color faces are included." (bluegreen "#009e73") (yellow "#f8ec59") (blue "#0072b2") - (vermillion "#d55e00") + (vermilion "#d55e00") (redpurple "#cc79a7") (bluegray "#848ea9")) (custom-theme-set-faces @@ -51,9 +51,9 @@ Ansi-Color faces are included." `(highlight ((,class (:foreground ,blue :background "#e5e5e5")))) `(region ((,class (:foreground unspecified :background ,yellow)))) `(secondary-selection ((,class (:background "#e5e5e5")))) - `(isearch ((,class (:foreground "white" :background ,vermillion)))) + `(isearch ((,class (:foreground "white" :background ,vermilion)))) `(lazy-highlight ((,class (:foreground "white" :background ,redpurple)))) - `(trailing-whitespace ((,class (:background ,vermillion)))) + `(trailing-whitespace ((,class (:background ,vermilion)))) ;; Mode line faces `(mode-line ((,class (:box (:line-width -1 :style released-button) :background "#e5e5e5" :foreground "black")))) @@ -62,17 +62,17 @@ Ansi-Color faces are included." :foreground "black")))) ;; Escape and prompt faces `(minibuffer-prompt ((,class (:weight bold :foreground ,blue)))) - `(escape-glyph ((,class (:foreground ,vermillion)))) - `(homoglyph ((,class (:foreground ,vermillion)))) + `(escape-glyph ((,class (:foreground ,vermilion)))) + `(homoglyph ((,class (:foreground ,vermilion)))) `(error ((,class (:weight bold :slant italic - :foreground ,vermillion)))) + :foreground ,vermilion)))) `(warning ((,class (:foreground ,orange)))) `(success ((,class (:foreground ,bluegreen)))) ;; Font lock faces `(font-lock-builtin-face ((,class (:foreground ,blue)))) `(font-lock-comment-face ((,class (:slant italic :foreground ,bluegreen)))) - `(font-lock-constant-face ((,class (:weight bold :foreground ,vermillion)))) - `(font-lock-function-name-face ((,class (:foreground ,vermillion)))) + `(font-lock-constant-face ((,class (:weight bold :foreground ,vermilion)))) + `(font-lock-function-name-face ((,class (:foreground ,vermilion)))) `(font-lock-keyword-face ((,class (:weight bold :foreground ,skyblue)))) `(font-lock-string-face ((,class (:foreground ,bluegray)))) `(font-lock-type-face ((,class (:weight bold :foreground ,blue)))) @@ -81,8 +81,8 @@ Ansi-Color faces are included." `(link ((,class (:underline t :foreground ,blue)))) `(link-visited ((,class (:underline t :foreground ,redpurple)))) ;; Gnus faces - `(gnus-group-news-1 ((,class (:weight bold :foreground ,vermillion)))) - `(gnus-group-news-1-low ((,class (:foreground ,vermillion)))) + `(gnus-group-news-1 ((,class (:weight bold :foreground ,vermilion)))) + `(gnus-group-news-1-low ((,class (:foreground ,vermilion)))) `(gnus-group-news-2 ((,class (:weight bold :foreground ,orange)))) `(gnus-group-news-2-low ((,class (:foreground ,orange)))) `(gnus-group-news-3 ((,class (:weight bold :foreground ,skyblue)))) @@ -92,8 +92,8 @@ Ansi-Color faces are included." `(gnus-group-news-5 ((,class (:weight bold :foreground ,blue)))) `(gnus-group-news-5-low ((,class (:foreground ,blue)))) `(gnus-group-news-low ((,class (:foreground ,bluegreen)))) - `(gnus-group-mail-1 ((,class (:weight bold :foreground ,vermillion)))) - `(gnus-group-mail-1-low ((,class (:foreground ,vermillion)))) + `(gnus-group-mail-1 ((,class (:weight bold :foreground ,vermilion)))) + `(gnus-group-mail-1-low ((,class (:foreground ,vermilion)))) `(gnus-group-mail-2 ((,class (:weight bold :foreground ,orange)))) `(gnus-group-mail-2-low ((,class (:foreground ,orange)))) `(gnus-group-mail-3 ((,class (:weight bold :foreground ,skyblue)))) @@ -103,13 +103,13 @@ Ansi-Color faces are included." `(gnus-header-from ((,class (:weight bold :foreground ,blue)))) `(gnus-header-subject ((,class (:foreground ,orange)))) `(gnus-header-name ((,class (:foreground ,skyblue)))) - `(gnus-header-newsgroups ((,class (:foreground ,vermillion)))) + `(gnus-header-newsgroups ((,class (:foreground ,vermilion)))) ;; Image-Dired - `(image-dired-thumb-flagged ((,class (:background ,vermillion)))) + `(image-dired-thumb-flagged ((,class (:background ,vermilion)))) `(image-dired-thumb-mark ((,class (:background ,orange)))) ;; Message faces `(message-header-name ((,class (:foreground ,skyblue)))) - `(message-header-cc ((,class (:foreground ,vermillion)))) + `(message-header-cc ((,class (:foreground ,vermilion)))) `(message-header-other ((,class (:foreground ,bluegreen)))) `(message-header-subject ((,class (:foreground ,orange)))) `(message-header-to ((,class (:weight bold :foreground ,blue)))) @@ -122,8 +122,8 @@ Ansi-Color faces are included." :slant unspecified :underline ,redpurple)))) ;; ANSI color `(ansi-color-black ((,class (:background "black" :foreground "black")))) - `(ansi-color-red ((,class (:background ,vermillion - :foreground ,vermillion)))) + `(ansi-color-red ((,class (:background ,vermilion + :foreground ,vermilion)))) `(ansi-color-green ((,class (:background ,bluegreen :foreground ,bluegreen)))) `(ansi-color-yellow ((,class (:background ,yellow :foreground ,yellow)))) @@ -134,8 +134,8 @@ Ansi-Color faces are included." `(ansi-color-white ((,class (:background "gray90" :foreground "gray90")))) `(ansi-color-bright-black ((,class (:background "black" :foreground "black")))) - `(ansi-color-bright-red ((,class (:background ,vermillion - :foreground ,vermillion)))) + `(ansi-color-bright-red ((,class (:background ,vermilion + :foreground ,vermilion)))) `(ansi-color-bright-green ((,class (:background ,bluegreen :foreground ,bluegreen)))) `(ansi-color-bright-yellow ((,class (:background ,yellow diff --git a/lib-src/ebrowse.c b/lib-src/ebrowse.c index 641570da02e..d3af926b634 100644 --- a/lib-src/ebrowse.c +++ b/lib-src/ebrowse.c @@ -1574,6 +1574,67 @@ yylex (void) end_string: return end_char == '\'' ? CCHAR : CSTRING; + case 'R': + if (GET (c) == '"') + { + /* C++11 rstrings. */ + +#define RSTRING_EOF_CHECK \ + do { \ + if (c == '\0') \ + { \ + yyerror ("unterminated c++11 rstring", NULL); \ + UNGET (); \ + return CSTRING; \ + } \ + } while (0) + + char *rstring_prefix_start = in; + + while (GET (c) != '(') + { + RSTRING_EOF_CHECK; + if (c == '"') + { + yyerror ("malformed c++11 rstring", NULL); + return CSTRING; + } + } + char *rstring_prefix_end = in - 1; + while (TRUE) + { + switch (GET (c)) + { + default: + RSTRING_EOF_CHECK; + break; + case '\n': + INCREMENT_LINENO; + break; + case ')': + { + char *in_saved = in; + char *prefix = rstring_prefix_start; + while (prefix != rstring_prefix_end && GET (c) == *prefix) + { + RSTRING_EOF_CHECK; + prefix++; + } + if (prefix == rstring_prefix_end) + { + if (GET (c) == '"') + return CSTRING; + RSTRING_EOF_CHECK; + } + in = in_saved; + } + } + } + } + + UNGET (); + /* Fall through to identifiers and keywords. */ + FALLTHROUGH; case 'a': case 'b': case 'c': case 'd': case 'e': case 'f': case 'g': case 'h': case 'i': case 'j': case 'k': case 'l': case 'm': case 'n': @@ -1581,7 +1642,7 @@ yylex (void) case 'v': case 'w': case 'x': case 'y': case 'z': case 'A': case 'B': case 'C': case 'D': case 'E': case 'F': case 'G': case 'H': case 'I': case 'J': case 'K': case 'L': case 'M': case 'N': - case 'O': case 'P': case 'Q': case 'R': case 'S': case 'T': case 'U': + case 'O': case 'P': case 'Q': case 'S': case 'T': case 'U': case 'V': case 'W': case 'X': case 'Y': case 'Z': case '_': { /* Identifier and keywords. */ diff --git a/lib-src/emacsclient.c b/lib-src/emacsclient.c index 425db8cface..ee124ea135c 100644 --- a/lib-src/emacsclient.c +++ b/lib-src/emacsclient.c @@ -2240,7 +2240,7 @@ main (int argc, char **argv) char *str = unquote_argument (p + strlen ("-error ")); if (!skiplf) printf ("\n"); - fprintf (stderr, "*ERROR*: %s", str); + message (true, "*ERROR*: %s", str); if (str[0]) skiplf = str[strlen (str) - 1] == '\n'; exit_status = EXIT_FAILURE; diff --git a/lisp/ChangeLog.10 b/lisp/ChangeLog.10 index 6053ffa65aa..de73fe7f0a2 100644 --- a/lisp/ChangeLog.10 +++ b/lisp/ChangeLog.10 @@ -1737,7 +1737,7 @@ (bibtex-find-crossref, bibtex-find-entry): New funs. (bibtex-find-entry-location): Rename to bibtex-prepare-new-entry, use bibtex-lessp, Simplify. - (bibtex-validate): Simplify. Fixe bug of internal variable + (bibtex-validate): Simplify. Fix bug of internal variable questionable-month. (bibtex-remove-OPT-or-ALT): Use when. (bibtex-remove-delimiters, bibtex-kill-field, bibtex-kill-entry) @@ -9449,7 +9449,7 @@ Use shy group. (outline-level) <var>: Update calling convention. (outline-level) <fun>: Take advantage of it. - (outline-demote): Don't assume the match-data is still uptodate. + (outline-demote): Don't assume the match-data is still up-to-date. (outline-up-heading): Simplify and make sure the match data is properly set at the end. diff --git a/lisp/ChangeLog.12 b/lisp/ChangeLog.12 index a89e5155106..0796965a9ba 100644 --- a/lisp/ChangeLog.12 +++ b/lisp/ChangeLog.12 @@ -1556,7 +1556,7 @@ (org-search-not-self): Rename from `org-search-not-link'. (org-open-link-marker): New variable. (org-open-at-point): Set `org-open-link-marker'. - (org-print-icalendar-entries): Fixe bug with excluding DONE + (org-print-icalendar-entries): Fix bug with excluding DONE entries from the exported list. (org-edit-formula-lisp-indent): New command. (orgtbl-to-texinfo, orgtbl-to-html): New functions. @@ -5243,7 +5243,7 @@ 2006-10-11 Ilya Zakharevich <ilyaz@cpan.org> - * progmodes/cperl-mode.el: Merge from upstream, upto version 5.22. + * progmodes/cperl-mode.el: Merge from upstream, up to version 5.22. After 5.0: (cperl-add-tags-recurse-noxs-fullpath): New function (for -batch mode). @@ -5551,7 +5551,7 @@ (cperl-next-interpolated-REx-1): Likewise. "\C-c\C-x", "\C-c\C-y", "\C-c\C-v": New keybinding for these functions. Perl/Regexp menu: 3 new entries for `cperl-next-interpolated-REx'. - (cperl-praise): Mention finded interpolated RExen. + (cperl-praise): Mention finding interpolated RExen. After 5.19: (cperl-init-faces): Highlight %$foo, @$foo too. @@ -11874,7 +11874,7 @@ * files.el (hack-local-variables-confirm): Don't prompt for ! if enable-local-variables is set to always query, or there is no - savable variable. + saveable variable. 2006-03-10 Bill Wohler <wohler@newt.com> diff --git a/lisp/ChangeLog.13 b/lisp/ChangeLog.13 index 369aec81ef1..326003d9d9d 100644 --- a/lisp/ChangeLog.13 +++ b/lisp/ChangeLog.13 @@ -1070,7 +1070,7 @@ * international/mule-cmds.el (char-code-property-alist): New variable. (define-char-code-property): New function. (get-char-code-property, put-char-code-property): Handle a - char-table registerd in char-code-property-alist. + char-table registered in char-code-property-alist. (set-language-environment): Check :ascii-compatible-p property of nonascii charset instead of its dimension. @@ -13901,7 +13901,7 @@ 2007-07-23 Stefan Monnier <monnier@iro.umontreal.ca> * ses.el (ses-cleanup): Prevent Emacs from spuriously checking if the - underlying file is uptodate. + underlying file is up-to-date. 2007-07-23 Christopher J. Madsen <cjm@cjmweb.net> @@ -15245,7 +15245,7 @@ 2007-06-25 Stefan Monnier <monnier@iro.umontreal.ca> * emacs-lisp/autoload.el (autoload-modified-buffers): New var. - (autoload-find-destination): Keep it uptodate. + (autoload-find-destination): Keep it up-to-date. (autoload-save-buffers): New fun. (update-file-autoloads): Use it. Re-add the "up to date" message. diff --git a/lisp/ChangeLog.14 b/lisp/ChangeLog.14 index 686746abe0b..8d8c6117788 100644 --- a/lisp/ChangeLog.14 +++ b/lisp/ChangeLog.14 @@ -6103,7 +6103,7 @@ * international/quail.el (quail-show-guidance): Don't create a guidance-frame if current buffer is not a minibuffer, since even if selected-window is mini-p, the buffer will never be displayed in it, so - it wil be usable for guidance. + it will be usable for guidance. 2008-10-28 Stefan Monnier <monnier@iro.umontreal.ca> diff --git a/lisp/ChangeLog.15 b/lisp/ChangeLog.15 index 23e61ff7872..8a21c291e72 100644 --- a/lisp/ChangeLog.15 +++ b/lisp/ChangeLog.15 @@ -11955,7 +11955,7 @@ (verilog-skip-backward-comments, verilog-skip-forward-comment-p): fix bug for /* / comments. (verilog-backward-syntactic-ws, verilog-forward-syntactic-ws): - Speed up and simplfy as this is never called with a bound. + Speed up and simplify as this is never called with a bound. (verilog-pretty-declarations): Enhance to line up declarations inside a parameter list, suggested by Alan Morgan. (verilog-pretty-expr): Tune assignment regular expression match @@ -15783,7 +15783,7 @@ * simple.el (with-wrapper-hook): Fix thinko. * hfy-cmap.el (hfy-rgb-file): Use locate-file. - (htmlfontify-load-rgb-file): Remove unnused var `ff'. + (htmlfontify-load-rgb-file): Remove unused var `ff'. Use with-current-buffer and string-to-number. (hfy-fallback-colour-values): Use assoc-string. * htmlfontify.el (hfy-face-to-css): Remove unused var `style'. @@ -22575,7 +22575,7 @@ 2009-06-28 Juri Linkov <juri@jurta.org> - * help-fns.el (describe-function-1): Correctly locate adviced + * help-fns.el (describe-function-1): Correctly locate advised functions in hyperlink (Bug#2438). 2009-06-28 Chong Yidong <cyd@stupidchicken.com> diff --git a/lisp/ChangeLog.16 b/lisp/ChangeLog.16 index f0a50bb4bc0..7b57c014d2b 100644 --- a/lisp/ChangeLog.16 +++ b/lisp/ChangeLog.16 @@ -2814,7 +2814,7 @@ 2012-12-12 Jonas Bernoulli <jonas@bernoul.li> * emacs-lisp/eieio.el: Prettier object pretty-printing (bug#13115). - (eieio-override-prin1): Don't quote kewords and booleans. + (eieio-override-prin1): Don't quote keywords and booleans. (object-write) <eieio-default-superclass>: Don't put closing parens on new line, avoid needless empty lines, align values that are objects with the slot keyword (instead of beginning on the same line). @@ -10765,7 +10765,7 @@ * play/zone.el (zone-hiding-mode-line): Rename from zone-hiding-modeline. All callers changed. - (zone): Remove unusued `modeline-hidden-level' property. + (zone): Remove unused `modeline-hidden-level' property. * progmodes/xscheme.el (xscheme-mode-line-initialize): Rename from xscheme-modeline-initialize. All callers changed. @@ -10931,7 +10931,7 @@ 2012-05-29 Aaron S. Hawley <aaron.s.hawley@gmail.com> - * vc/vc.el (vc-revert, vc-rollback): Dont kill vc-diff buffer on + * vc/vc.el (vc-revert, vc-rollback): Don't kill vc-diff buffer on revert (Bug#11488). 2012-05-29 Juri Linkov <juri@jurta.org> @@ -15340,7 +15340,7 @@ * subr.el (with-selected-frame): Mention that the selected frame is restored (bug#9980). - * ibuffer.el (ibuffer-mode): List the bindings in the corrent map + * ibuffer.el (ibuffer-mode): List the bindings in the correct map (bug#9759). * mail/smtpmail.el (password-cache-add): Remove unused declaration. @@ -22838,15 +22838,14 @@ 2011-05-10 Jim Meyering <meyering@redhat.com> Fix doubled-word typos. - * international/quail.el (quail-insert-kbd-layout): and and -> and. - * kermit.el: and and -> and. - * net/ldap.el (ldap-search-internal): to to -> to. - * progmodes/vhdl-mode.el (vhdl-offsets-alist): Likewise. - * progmodes/js.el (js-mode): and and -> and. - * textmodes/artist.el (artist-move-to-xy): at at -> at. - (artist-draw-region-trim-line-endings): if if -> if. - And Safetyc -> Safety. - * textmodes/reftex-dcr.el (reftex-view-crossref): at at -> at a. + * international/quail.el (quail-insert-kbd-layout): + * kermit.el: + * net/ldap.el (ldap-search-internal): + * progmodes/vhdl-mode.el (vhdl-offsets-alist): + * progmodes/js.el (js-mode): + * textmodes/artist.el (artist-move-to-xy): + (artist-draw-region-trim-line-endings): + * textmodes/reftex-dcr.el (reftex-view-crossref): Fix typos. 2011-05-10 Glenn Morris <rgm@gnu.org> Stefan Monnier <monnier@iro.umontreal.ca> @@ -24104,7 +24103,7 @@ * emacs-lisp/lisp-mode.el (eval-defun-2): Use eval-sexp-add-defvars. - * htmlfontify.el (hfy-etags-cmd): Remove inoperant eval-and-compile. + * htmlfontify.el (hfy-etags-cmd): Remove inoperative eval-and-compile. (hfy-e2x-etags-cmd, hfy-etags-cmd-alist-default) (hfy-etags-cmd-alist): Don't eval-and-compile any more. diff --git a/lisp/ChangeLog.17 b/lisp/ChangeLog.17 index df731fe9ed2..c494f438967 100644 --- a/lisp/ChangeLog.17 +++ b/lisp/ChangeLog.17 @@ -917,7 +917,7 @@ * desktop.el (desktop-buffer-info): Write docstring. (desktop-buffer-info): Use `pushnew' instead of `add-to-list' and - unquote lamda. + unquote lambda. * emacs-lisp/package.el (package-refresh-contents): Update doc. diff --git a/lisp/ChangeLog.3 b/lisp/ChangeLog.3 index 7f5ceb4b854..e23226b8440 100644 --- a/lisp/ChangeLog.3 +++ b/lisp/ChangeLog.3 @@ -7326,8 +7326,7 @@ 1991-07-13 Jim Blandy (jimb@churchy.gnu.ai.mit.edu) * info.el (Info-find-node): Call buffer-flush-undo with one arg, - instead of none. Change call to get-buffer-c>reate to - get-buffer-create. + instead of none. Fix typo in call to get-buffer-create. * startup.el (command-line): Remove the arguments from command-line-args as we process them. diff --git a/lisp/ChangeLog.4 b/lisp/ChangeLog.4 index e965dbb5ef8..ea0502975ec 100644 --- a/lisp/ChangeLog.4 +++ b/lisp/ChangeLog.4 @@ -6858,7 +6858,7 @@ 1993-07-26 Richard Stallman (rms@mole.gnu.ai.mit.edu) * frame.el (frame-notice-user-settings): Don't reapply a parm - whose value is ot changed (as far as we know) since frame-initialize. + whose value is not changed (as far as we know) since frame-initialize. * simple.el (kill-ring-save): Delete spurious `message' call. (set-mark): If POS is nil, call deactivate-mark. diff --git a/lisp/ChangeLog.6 b/lisp/ChangeLog.6 index e2128b94c0d..27d522aaf2a 100644 --- a/lisp/ChangeLog.6 +++ b/lisp/ChangeLog.6 @@ -7392,7 +7392,7 @@ (ada-format-paramlist): Simplified a regexp. (ada-indent-current): On first line of the buffer, indent to column 0. Don't reindent if new position is the same as the old one. Thus, a - correctly indended line is not modified. + correctly indented line is not modified. (ada-get-indent-subprog): Simplified a regexp. (ada-goto-matching-decl-start): Distinguish between normal type declaration and protected types, which are more like procedures. diff --git a/lisp/ChangeLog.7 b/lisp/ChangeLog.7 index 747a9ffab98..32208324541 100644 --- a/lisp/ChangeLog.7 +++ b/lisp/ChangeLog.7 @@ -3147,20 +3147,20 @@ * international/ccl.el: Change term translate-XXX-map to map-XXX throughout the file. Change terms unify/unification to - translate/translation respectively throughtout the file. + translate/translation respectively throughout the file. * international/quail.el (quail-completion): Consecutive call of this command scrolls the Quail completion buffer. * international/mule.el: Change term unification to translation - throughtout the file. + throughout the file. (set-clipboard-coding-system): New function. * international/mule-conf.el: Change term unification to - translation throughtout the file. + translation throughout the file. * international/mule-util.el: Change term unification to - translation throughtout the file. + translation throughout the file. 1998-05-17 Richard Stallman <rms@psilocin.ai.mit.edu> @@ -20821,7 +20821,7 @@ function word-help-find-help-file. (word-help-guess-all): New subroutine. (word-help-guess): Use word-help-guess-all. - May optionally copy only upto the cursor, + May optionally copy only up to the cursor, instead of the entire keyword. 1997-01-01 Richard Stallman <rms@ethanol.gnu.ai.mit.edu> diff --git a/lisp/ChangeLog.8 b/lisp/ChangeLog.8 index 78fc7e20566..a14d6821925 100644 --- a/lisp/ChangeLog.8 +++ b/lisp/ChangeLog.8 @@ -4356,7 +4356,7 @@ 1999-07-21 Gerd Moellmann <gerd@gnu.org> * scroll-bar.el (scroll-bar-toolkit-scroll): New. - (global): Use different key bindings if using tookit scroll bars. + (global): Use different key bindings if using toolkit scroll bars. 1999-07-21 Gerd Moellmann <gerd@gnu.org> @@ -9712,7 +9712,7 @@ (ps-mule-font-info-database-ps-bdf): New variable. (ccl-encode-ethio-unicode): Bug of CCL code fixed. (ps-mule-generate-font): Give CHARSET arg to FONT-FUNC function - registerd in FONT-SPEC. + registered in FONT-SPEC. (ps-mule-bitmap-prologue): Fix PostScript code to realize correct character width of bitmap fonts. (ps-mule-generate-bitmap-font): Give COLUMNS arg to PostScript diff --git a/lisp/ChangeLog.9 b/lisp/ChangeLog.9 index a8ebe81e7d7..4cb10d2d55e 100644 --- a/lisp/ChangeLog.9 +++ b/lisp/ChangeLog.9 @@ -789,7 +789,7 @@ (command-line-1): If inhibit-startup-buffer-menu is set, don't display the buffer menu. From Simon Josefsson <jas@extundo.com>. - This allows upto 99999 messages in the summary without screwing up + This allows up to 99999 messages in the summary without screwing up the summary sorting. Previously 9999 was the maximum. Added to NEWS. * mail/rmailsum.el (rmail-make-summary-line) diff --git a/lisp/allout.el b/lisp/allout.el index 5f7087829e2..df0181cecbd 100644 --- a/lisp/allout.el +++ b/lisp/allout.el @@ -5356,9 +5356,6 @@ alternate presentation form: `flat' -- Present prefix as numeric section.subsection..., starting with section indicated by the START-NUM, innermost nesting first. - X`flat-indented' -- Prefix is like `flat' for first topic at each - X level, but subsequent topics have only leaf topic - X number, padded with blanks to line up with first. `indent' (symbol) -- Convert header prefixes to all white space, except for distinctive bullets. diff --git a/lisp/ansi-osc.el b/lisp/ansi-osc.el index 499c9dce73a..a8523fc9dc2 100644 --- a/lisp/ansi-osc.el +++ b/lisp/ansi-osc.el @@ -141,7 +141,7 @@ and `shell-dirtrack-mode'." (defun ansi-osc-hyperlink-handler (_ text) "Create a hyperlink from an OSC 8 escape sequence. -This function is intended to be included as an elemnt of the list +This function is intended to be included as an element of the list that is the value of `ansi-osc-handlers'." (when ansi-osc-hyperlink--state (let ((start (car ansi-osc-hyperlink--state)) diff --git a/lisp/apropos.el b/lisp/apropos.el index 624c29cb410..a731926f458 100644 --- a/lisp/apropos.el +++ b/lisp/apropos.el @@ -25,8 +25,7 @@ ;;; Commentary: ;; The ideas for this package were derived from the C code in -;; src/keymap.c and elsewhere. The functions in this file should -;; always be byte-compiled for speed. +;; src/keymap.c and elsewhere. ;; The idea for super-apropos is based on the original implementation ;; by Lynn Slater <lrs@esl.com>. @@ -493,7 +492,7 @@ Intended as a value for `revert-buffer-function'." \\{apropos-mode-map}" (make-local-variable 'apropos--current) (setq-local revert-buffer-function #'apropos--revert-buffer) - (setq-local outline-regexp "^[^ \n]+" + (setq-local outline-search-function #'outline-search-level outline-level (lambda () 1) outline-minor-mode-cycle t outline-minor-mode-highlight t @@ -652,7 +651,8 @@ while a list of strings is used as a word list." (defun apropos (pattern &optional do-all) "Show all meaningful Lisp symbols whose names match PATTERN. Symbols are shown if they are defined as functions, variables, or -faces, or if they have nonempty property lists. +faces, or if they have nonempty property lists, or if they are +known keywords. PATTERN can be a word, a list of words (separated by spaces), or a regexp (using some regexp special characters). If it is a word, @@ -1188,7 +1188,8 @@ as a heading." (insert-text-button (symbol-name symbol) 'type 'apropos-symbol 'skip apropos-multi-type - 'face 'apropos-symbol) + 'face 'apropos-symbol + 'outline-level 1) (setq button-end (point)) (if (and (eq apropos-sort-by-scores 'verbose) (cadr apropos-item)) diff --git a/lisp/auth-source-pass.el b/lisp/auth-source-pass.el index 0955e2ed07e..dc274843e10 100644 --- a/lisp/auth-source-pass.el +++ b/lisp/auth-source-pass.el @@ -55,13 +55,27 @@ :type 'string :version "27.1") +(defcustom auth-source-pass-extra-query-keywords t + "Whether to consider additional keywords when performing a query. +Specifically, when the value is t, recognize the `:max' and +`:require' keywords and accept lists of query parameters for +certain keywords, such as `:host' and `:user'. Also, wrap all +returned secrets in a function and forgo any further results +filtering unless given an applicable `:require' argument. When +this option is nil, do none of that, and enact the narrowing +behavior described toward the bottom of the Info node `(auth) The +Unix password store'." + :type 'boolean + :version "29.1") + (cl-defun auth-source-pass-search (&rest spec &key backend type host user port + require max &allow-other-keys) "Given some search query, return matching credentials. See `auth-source-search' for details on the parameters SPEC, BACKEND, TYPE, -HOST, USER and PORT." +HOST, USER, PORT, REQUIRE, and MAX." (cl-assert (or (null type) (eq type (oref backend type))) t "Invalid password-store search: %s %s") (cond ((eq host t) @@ -70,6 +84,8 @@ HOST, USER and PORT." ((null host) ;; Do not build a result, as none will match when HOST is nil nil) + (auth-source-pass-extra-query-keywords + (auth-source-pass--build-result-many host port user require max)) (t (when-let ((result (auth-source-pass--build-result host port user))) (list result))))) @@ -89,6 +105,39 @@ HOSTS can be a string or a list of strings." (seq-subseq retval 0 -2)) ;; remove password retval)))) +(defvar auth-source-pass--match-regexp nil) + +(defun auth-source-pass--match-regexp (s) + (rx-to-string ; autoloaded + `(: (or bot "/") + (or (: (? (group-n 20 (+ (not (in ?\ ?/ ?@ ,s)))) "@") + (group-n 10 (+ (not (in ?\ ?/ ?@ ,s)))) + (? ,s (group-n 30 (+ (not (in ?\ ?/ ,s)))))) + (: (group-n 11 (+ (not (in ?\ ?/ ?@ ,s)))) + (? ,s (group-n 31 (+ (not (in ?\ ?/ ,s))))) + (? "/" (group-n 21 (+ (not (in ?\ ?/ ,s))))))) + eot) + 'no-group)) + +(defun auth-source-pass--build-result-many (hosts ports users require max) + "Return multiple `auth-source-pass--build-result' values." + (unless (listp hosts) (setq hosts (list hosts))) + (unless (listp users) (setq users (list users))) + (unless (listp ports) (setq ports (list ports))) + (let* ((auth-source-pass--match-regexp (auth-source-pass--match-regexp + auth-source-pass-port-separator)) + (rv (auth-source-pass--find-match-many hosts users ports + require (or max 1)))) + (when auth-source-debug + (auth-source-pass--do-debug "final result: %S" rv)) + (let (out) + (dolist (e rv out) + (when-let* ((s (plist-get e :secret)) ; not captured by closure in 29.1 + (v (auth-source--obfuscate s))) + (setf (plist-get e :secret) + (lambda () (auth-source--deobfuscate v)))) + (push e out))))) + ;;;###autoload (defun auth-source-pass-enable () "Enable auth-source-password-store." @@ -206,6 +255,67 @@ HOSTS can be a string or a list of strings." hosts (list hosts)))) +(defun auth-source-pass--retrieve-parsed (seen path port-number-p) + (when (string-match auth-source-pass--match-regexp path) + (puthash path + `( :host ,(or (match-string 10 path) (match-string 11 path)) + ,@(if-let* ((tr (match-string 21 path))) + (list :user tr :suffix t) + (list :user (match-string 20 path))) + :port ,(and-let* ((p (or (match-string 30 path) + (match-string 31 path))) + (n (string-to-number p))) + (if (or (zerop n) (not port-number-p)) + (format "%s" p) + n))) + seen))) + +(defun auth-source-pass--match-parts (parts key value require) + (let ((mv (plist-get parts key))) + (if (memq key require) + (and value (equal mv value)) + (or (not value) (not mv) (equal mv value))))) + +(defun auth-source-pass--find-match-many (hosts users ports require max) + "Return plists for valid combinations of HOSTS, USERS, PORTS." + (let ((seen (make-hash-table :test #'equal)) + (entries (auth-source-pass-entries)) + out suffixed suffixedp) + (catch 'done + (dolist (host hosts out) + (pcase-let ((`(,_ ,u ,p) (auth-source-pass--disambiguate host))) + (unless (or (not (equal "443" p)) (string-prefix-p "https://" host)) + (setq p nil)) + (dolist (user (or users (list u))) + (dolist (port (or ports (list p))) + (dolist (e entries) + (when-let* + ((m (or (gethash e seen) (auth-source-pass--retrieve-parsed + seen e (integerp port)))) + ((equal host (plist-get m :host))) + ((auth-source-pass--match-parts m :port port require)) + ((auth-source-pass--match-parts m :user user require)) + (parsed (auth-source-pass-parse-entry e)) + ;; For now, ignore body-content pairs, if any, + ;; from `auth-source-pass--parse-data'. + (secret (or (auth-source-pass--get-attr 'secret parsed) + (not (memq :secret require))))) + (push + `( :host ,host ; prefer user-provided :host over h + ,@(and-let* ((u (plist-get m :user))) (list :user u)) + ,@(and-let* ((p (plist-get m :port))) (list :port p)) + ,@(and secret (not (eq secret t)) (list :secret secret))) + (if (setq suffixedp (plist-get m :suffix)) suffixed out)) + (unless suffixedp + (when (or (zerop (cl-decf max)) + (null (setq entries (delete e entries)))) + (throw 'done out))))) + (setq suffixed (nreverse suffixed)) + (while suffixed + (push (pop suffixed) out) + (when (zerop (cl-decf max)) + (throw 'done out)))))))))) + (defun auth-source-pass--disambiguate (host &optional user port) "Return (HOST USER PORT) after disambiguation. Disambiguate between having user provided inside HOST (e.g., diff --git a/lisp/bookmark.el b/lisp/bookmark.el index b57ad12986d..7f3a264f53d 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -365,8 +365,8 @@ BOOKMARK-RECORD is, e.g., one element from `bookmark-alist'." (car bookmark-record)) (defun bookmark-type-from-full-record (bookmark-record) - "Return then type of BOOKMARK-RECORD. -BOOKMARK-RECORD is, e.g., one element from `bookmark-alist'. It's + "Return the type of BOOKMARK-RECORD. +BOOKMARK-RECORD is, e.g., one element from `bookmark-alist'. Its type is read from the symbol property named `bookmark-handler-type' read on the record handler function." (let ((handler (bookmark-get-handler bookmark-record))) @@ -1396,20 +1396,25 @@ after a bookmark was set in it." (interactive (list (bookmark-completing-read "Bookmark to relocate"))) (bookmark-maybe-historicize-string bookmark-name) (bookmark-maybe-load-default-file) - (let* ((bmrk-filename (bookmark-get-filename bookmark-name)) - (newloc (abbreviate-file-name - (expand-file-name - (read-file-name - (format "Relocate %s to: " bookmark-name) - (file-name-directory bmrk-filename)))))) - (bookmark-set-filename bookmark-name newloc) - (bookmark-update-last-modified bookmark-name) - (setq bookmark-alist-modification-count - (1+ bookmark-alist-modification-count)) - (if (bookmark-time-to-save-p) + (let ((bmrk-filename (bookmark-get-filename bookmark-name))) + ;; FIXME: Make `bookmark-relocate' support bookmark Types + ;; besides files and directories. + (unless bmrk-filename + (user-error "Cannot relocate bookmark of type \"%s\"" + (bookmark-type-from-full-record + (bookmark-get-bookmark bookmark-name)))) + (let ((newloc (abbreviate-file-name + (expand-file-name + (read-file-name + (format "Relocate %s to: " bookmark-name) + (file-name-directory bmrk-filename)))))) + (bookmark-set-filename bookmark-name newloc) + (bookmark-update-last-modified bookmark-name) + (setq bookmark-alist-modification-count + (1+ bookmark-alist-modification-count)) + (when (bookmark-time-to-save-p) (bookmark-save)) - (bookmark-bmenu-surreptitiously-rebuild-list))) - + (bookmark-bmenu-surreptitiously-rebuild-list)))) ;;;###autoload (defun bookmark-insert-location (bookmark-name &optional no-history) diff --git a/lisp/bs.el b/lisp/bs.el index aabc2dc5583..1fd31fb3b85 100644 --- a/lisp/bs.el +++ b/lisp/bs.el @@ -25,7 +25,7 @@ ;;; Commentary: -;; The bs-package contains a main function bs-show for popping up a +;; The bs package contains a main function `bs-show' for popping up a ;; buffer in a way similar to `list-buffers' and `electric-buffer-list': ;; The new buffer offers a Buffer Selection Menu for manipulating ;; the buffer list and buffers. @@ -42,18 +42,18 @@ ;;; Quick Installation and Customization: -;; To display the bs menu, do +;; To display the bs menu, type ;; M-x bs-show -;; To customize its behavior, do +;; To customize its behavior, type ;; M-x bs-customize ;;; More Commentary: -;; bs-show will generate a new buffer named *buffer-selection*, which shows +;; `bs-show' will generate a new buffer named *buffer-selection*, which shows ;; all buffers or a subset of them, and has possibilities for deleting, -;; saving and selecting buffers. For more details see docstring of -;; function `bs-mode'. A current configuration describes which buffers appear -;; in *buffer-selection*. See docstring of variable `bs-configurations' for +;; saving and selecting buffers. For more details see docstring of +;; function `bs-mode'. A current configuration describes which buffers appear +;; in *buffer-selection*. See docstring of variable `bs-configurations' for ;; more details. ;; ;; The package bs combines the advantages of the Emacs functions @@ -70,7 +70,7 @@ ;;; Cycling through buffers -;; This package offers two functions for buffer cycling. If you want to cycle +;; This package offers two functions for buffer cycling. If you want to cycle ;; through buffer list you can use `bs-cycle-next' or `bs-cycle-previous'. ;; Bind these function to a key like ;; (global-set-key [(f9)] 'bs-cycle-previous) @@ -80,7 +80,7 @@ ;; to go through internal buffers like *Messages*. ;; ;; Cycling through buffers ignores sorting because sorting destroys -;; the logical buffer list. If buffer list is sorted by size you +;; the logical buffer list. If buffer list is sorted by size you ;; won't be able to cycle to the smallest buffer. ;;; Customization: @@ -114,7 +114,7 @@ ;; When cycling through buffer list the functions for cycling will use ;; the current configuration of bs to calculate the buffer list. ;; If you want to use a different configuration for cycling you have to set -;; the variable `bs-cycle-configuration-name'. You can customize this variable. +;; the variable `bs-cycle-configuration-name'. You can customize this variable. ;; ;; For example: If you use the configuration called "files-and-scratch" you ;; can cycle through all file buffers and *scratch* although your current @@ -390,9 +390,9 @@ column title to highlight. FACE is a face used to fontify the sorted column title. A value of nil means don't highlight. The new sort aspect will be inserted into list `bs-sort-functions'." - (let ((tupel (assoc name bs-sort-functions))) - (if tupel - (setcdr tupel (list fun regexp-for-sorting face)) + (let ((tuple (assoc name bs-sort-functions))) + (if tuple + (setcdr tuple (list fun regexp-for-sorting face)) (setq bs-sort-functions (cons (list name fun regexp-for-sorting face) bs-sort-functions))))) @@ -823,10 +823,14 @@ Leave Buffer Selection Menu." "Visit the tags table in the buffer on this line. See `visit-tags-table'." (interactive) - (let ((file (buffer-file-name (bs--current-buffer)))) - (if file - (visit-tags-table file) - (error "Specified buffer has no file")))) + (let* ((buf (bs--current-buffer)) + (file (buffer-file-name buf))) + (cond + ((not file) (error "Specified buffer has no file")) + ((and buf (with-current-buffer buf + (etags-verify-tags-table))) + (visit-tags-table file)) + (t (error "Specified buffer is not a tags-table"))))) (defun bs-toggle-current-to-show () "Toggle status of showing flag for buffer in current line." @@ -1236,13 +1240,13 @@ by buffer configuration `bs-cycle-configuration-name'." (bs-set-configuration (or bs-cycle-configuration-name bs-default-configuration)) (let ((bs-buffer-sort-function nil) (bs--current-sort-function nil)) - (let* ((tupel (bs-next-buffer (if (or (eq last-command + (let* ((tuple (bs-next-buffer (if (or (eq last-command 'bs-cycle-next) (eq last-command 'bs-cycle-previous)) bs--cycle-list))) - (next (car tupel)) - (cycle-list (cdr tupel))) + (next (car tuple)) + (cycle-list (cdr tuple))) ;; We don't want the frame iconified if the only window in the frame ;; happens to be dedicated. (bury-buffer (current-buffer)) @@ -1268,13 +1272,13 @@ by buffer configuration `bs-cycle-configuration-name'." (bs-set-configuration (or bs-cycle-configuration-name bs-default-configuration)) (let ((bs-buffer-sort-function nil) (bs--current-sort-function nil)) - (let* ((tupel (bs-previous-buffer (if (or (eq last-command + (let* ((tuple (bs-previous-buffer (if (or (eq last-command 'bs-cycle-next) (eq last-command 'bs-cycle-previous)) bs--cycle-list))) - (prev-buffer (car tupel)) - (cycle-list (cdr tupel))) + (prev-buffer (car tuple)) + (cycle-list (cdr tuple))) (switch-to-buffer prev-buffer nil t) (setq bs--cycle-list (append (last cycle-list) (reverse (cdr (reverse cycle-list))))) diff --git a/lisp/buff-menu.el b/lisp/buff-menu.el index abf152f058c..aa5f70edf23 100644 --- a/lisp/buff-menu.el +++ b/lisp/buff-menu.el @@ -1,7 +1,6 @@ ;;; buff-menu.el --- Interface for viewing and manipulating buffers -*- lexical-binding: t -*- -;; Copyright (C) 1985-1987, 1993-1995, 2000-2022 Free Software -;; Foundation, Inc. +;; Copyright (C) 1985-2022 Free Software Foundation, Inc. ;; Maintainer: emacs-devel@gnu.org ;; Keywords: convenience @@ -101,6 +100,13 @@ as it is by default." This is set by the prefix argument to `buffer-menu' and related commands.") +(defvar-local Buffer-menu-filter-predicate nil + "Function to filter out buffers in the buffer list. +Buffers that don't satisfy the predicate will be skipped. +The value should be a function of one argument; it will be +called with the buffer. If this function returns non-nil, +then the buffer will be displayed in the buffer list.") + (defvar-keymap Buffer-menu-mode-map :doc "Local keymap for `Buffer-menu-mode' buffers." :parent tabulated-list-mode-map @@ -133,10 +139,12 @@ commands.") "M-s a C-s" #'Buffer-menu-isearch-buffers "M-s a C-M-s" #'Buffer-menu-isearch-buffers-regexp "M-s a C-o" #'Buffer-menu-multi-occur - "<mouse-2>" #'Buffer-menu-mouse-select "<follow-link>" 'mouse-face) +(put 'Buffer-menu-delete :advertised-binding "d") +(put 'Buffer-menu-this-window :advertised-binding "f") + (easy-menu-define Buffer-menu-mode-menu Buffer-menu-mode-map "Menu for `Buffer-menu-mode' buffers." '("Buffer-Menu" @@ -236,6 +244,26 @@ In Buffer Menu mode, the following commands are defined: (lambda (&optional _noconfirm) 'fast)) (add-hook 'tabulated-list-revert-hook 'list-buffers--refresh nil t)) +(defun buffer-menu--display-help () + (message "%s" + (substitute-command-keys + (concat + "Commands: " + "\\<Buffer-menu-mode-map>" + "\\[Buffer-menu-delete], " + "\\[Buffer-menu-save], " + "\\[Buffer-menu-execute], " + "\\[Buffer-menu-unmark]; " + "\\[Buffer-menu-this-window], " + "\\[Buffer-menu-other-window], " + "\\[Buffer-menu-1-window], " + "\\[Buffer-menu-2-window], " + "\\[Buffer-menu-mark], " + "\\[Buffer-menu-select]; " + "\\[Buffer-menu-not-modified], " + "\\[Buffer-menu-toggle-read-only]; " + "\\[quit-window] to quit; \\[describe-mode] for help")))) + (defun buffer-menu (&optional arg) "Switch to the Buffer Menu. By default, the Buffer Menu lists all buffers except those whose @@ -261,8 +289,7 @@ the `Buffer-menu-name-width', `Buffer-menu-size-width' and `Buffer-menu-mode-width' variables." (interactive "P") (switch-to-buffer (list-buffers-noselect arg)) - (message - "Commands: d, s, x, u; f, o, 1, 2, m, v; ~, %%; q to quit; ? for help.")) + (buffer-menu--display-help)) (defun buffer-menu-other-window (&optional arg) "Display the Buffer Menu in another window. @@ -273,8 +300,7 @@ with a space (which are for internal use). With prefix argument ARG, show only buffers that are visiting files." (interactive "P") (switch-to-buffer-other-window (list-buffers-noselect arg)) - (message - "Commands: d, s, x, u; f, o, 1, 2, m, v; ~, %%; q to quit; ? for help.")) + (buffer-menu--display-help)) ;;;###autoload (defun list-buffers (&optional arg) @@ -597,19 +623,23 @@ This behaves like invoking \\[read-only-mode] in that buffer." ;;; Functions for populating the Buffer Menu. ;;;###autoload -(defun list-buffers-noselect (&optional files-only buffer-list) +(defun list-buffers-noselect (&optional files-only buffer-list filter-predicate) "Create and return a Buffer Menu buffer. This is called by `buffer-menu' and others as a subroutine. If FILES-ONLY is non-nil, show only file-visiting buffers. If BUFFER-LIST is non-nil, it should be a list of buffers; it -means list those buffers and no others." +means list those buffers and no others. +If FILTER-PREDICATE is non-nil, it should be a function +that filters out buffers from the list of buffers. +See more at `Buffer-menu-filter-predicate'." (let ((old-buffer (current-buffer)) (buffer (get-buffer-create "*Buffer List*"))) (with-current-buffer buffer (Buffer-menu-mode) (setq Buffer-menu-files-only (and files-only (>= (prefix-numeric-value files-only) 0))) + (setq Buffer-menu-filter-predicate filter-predicate) (list-buffers--refresh buffer-list old-buffer) (tabulated-list-print)) buffer)) @@ -631,6 +661,8 @@ means list those buffers and no others." (marked-buffers (Buffer-menu-marked-buffers)) (buffer-menu-buffer (current-buffer)) (show-non-file (not Buffer-menu-files-only)) + (filter-predicate (and (functionp Buffer-menu-filter-predicate) + Buffer-menu-filter-predicate)) entries name-width) ;; Collect info for each buffer we're interested in. (dolist (buffer (or buffer-list @@ -644,7 +676,9 @@ means list those buffers and no others." (and (or (not (string= (substring name 0 1) " ")) file) (not (eq buffer buffer-menu-buffer)) - (or file show-non-file)))) + (or file show-non-file) + (or (not filter-predicate) + (funcall filter-predicate buffer))))) (push (list buffer (vector (cond ((eq buffer old-buffer) ".") diff --git a/lisp/calc/calc-graph.el b/lisp/calc/calc-graph.el index a95967bef4e..5735126bf50 100644 --- a/lisp/calc/calc-graph.el +++ b/lisp/calc/calc-graph.el @@ -1414,7 +1414,7 @@ This \"dumb\" driver will be present in Gnuplot 3.0." (defun calc-gnuplot-command (&rest args) "Send ARGS to Gnuplot. -Returns nil if Gnuplot signalled an error." +Returns nil if Gnuplot signaled an error." (calc-graph-init) (let ((cmd (concat (mapconcat 'identity args " ") "\n"))) (or (calc-graph-w32-p) diff --git a/lisp/calendar/diary-lib.el b/lisp/calendar/diary-lib.el index 98e91aaa75e..9a2baf1e43c 100644 --- a/lisp/calendar/diary-lib.el +++ b/lisp/calendar/diary-lib.el @@ -92,7 +92,7 @@ are holidays." This is used by `diary-pull-attrs' to fontify certain diary elements. REGEXP is a regular expression to for, and SUBEXP is the numbered sub-expression to extract. `diary-glob-file-regexp-prefix' -is pre-pended to REGEXP for file-wide specifiers. ATTRIBUTE +is prepended to REGEXP for file-wide specifiers. ATTRIBUTE specifies which face attribute (e.g. `:foreground') to modify, or that this is a face (`:face') to apply. TYPE is the type of attribute being applied. Available TYPES (see `diary-attrtype-convert') @@ -109,7 +109,7 @@ are: `string', `symbol', `int', `tnil', `stringtnil'." :group 'diary) (defcustom diary-glob-file-regexp-prefix "^#" - "Regular expression pre-pended to `diary-face-attrs' for file-wide specifiers." + "Regular expression prepended to `diary-face-attrs' for file-wide specifiers." :type 'regexp :group 'diary) @@ -1769,7 +1769,7 @@ These functions give the date in alternative calendrical systems: `diary-islamic-date', `diary-julian-date', `diary-mayan-date', `diary-persian-date' -Theses functions only produce output on certain dates: +These functions only produce output on certain dates: `diary-lunar-phases' - phases of moon (on the appropriate days) `diary-hebrew-omer' - Omer count, within 50 days after Passover diff --git a/lisp/cedet/ChangeLog.1 b/lisp/cedet/ChangeLog.1 index aa54bdd9b0b..78275f4db3a 100644 --- a/lisp/cedet/ChangeLog.1 +++ b/lisp/cedet/ChangeLog.1 @@ -459,7 +459,7 @@ * semantic/scope.el (semantic-analyze-scoped-types-default): If we cannot find a type in the typecache, also look into the types we already found. This is necessary since in C++, a 'using - namespace' can be dependend on a previous one. + namespace' can be dependent on a previous one. (semantic-completable-tags-from-type): When creating the list of completable types, pull in types which are referenced through 'using' statements, and also preserve their filenames. @@ -1546,7 +1546,7 @@ (ede-proj-makefile-dependencies): Update pattern rule so that resulting parsers are also byte-compiled. (semantic-ede-grammar-compiler-bovine) - (semantic-ede-source-grammar-wisent): Remove .elc from gargage + (semantic-ede-source-grammar-wisent): Remove .elc from garbage pattern, since this is already covered by the elisp compiler. (project-compile-target): Add compatibility code for Emacs 23, which does not have `byte-recompile-file'. @@ -1915,10 +1915,9 @@ 2011-05-10 Jim Meyering <meyering@redhat.com> Fix doubled-word typos. - * ede/pmake.el (ede-proj-makefile-garbage-patterns): the the -> the + * ede/pmake.el (ede-proj-makefile-garbage-patterns): * semantic/complete.el (semantic-complete-read-tag-local-members): - Likewise. - * ede.el (ede-auto-add-method): then then -> then + * ede.el (ede-auto-add-method): Fix typos. 2011-04-23 Juanma Barranquero <lekktu@gmail.com> @@ -3098,7 +3097,7 @@ * ede/proj-prog.el (project-run-target): New method. * ede/proj-obj.el (ede-cc-linker): Rename from ede-gcc-linker. - (ede-g++-linker): Change Change link lines. + (ede-g++-linker): Change link lines. * ede/pmake.el (ede-pmake-insert-variable-shared): When searching for old variables, go to the end of the buffer and diff --git a/lisp/cedet/ede.el b/lisp/cedet/ede.el index e6bfd0b1e85..1118235757c 100644 --- a/lisp/cedet/ede.el +++ b/lisp/cedet/ede.el @@ -598,7 +598,7 @@ an EDE controlled project." "\\.#" "~$" ) - "List of file name patters that EDE will never ask about.") + "List of file name patterns that EDE will never ask about.") (defun ede-ignore-file (filename) "Should we ignore FILENAME?" diff --git a/lisp/cedet/ede/makefile-edit.el b/lisp/cedet/ede/makefile-edit.el index 1b424bc6d0c..5aaa5b2687c 100644 --- a/lisp/cedet/ede/makefile-edit.el +++ b/lisp/cedet/ede/makefile-edit.el @@ -35,7 +35,7 @@ ;; SOURCE always keep in the order of .c, .h, the other stuff. ;;; Things to do -;; makefile-fill-paragraph -- refill a macro w/ backslashes +;; makefile-fill-paragraph -- refill a macro with backslashes ;; makefile-insert-macro -- insert "foo = " diff --git a/lisp/cedet/ede/proj.el b/lisp/cedet/ede/proj.el index 7a486754a03..398e08a1a9d 100644 --- a/lisp/cedet/ede/proj.el +++ b/lisp/cedet/ede/proj.el @@ -43,7 +43,7 @@ (autoload 'ede-proj-target-scheme "ede/proj-scheme" "Target class for a group of lisp files." nil nil) (autoload 'ede-proj-target-makefile-miscelaneous "ede/proj-misc" - "Target class for a group of miscellaneous w/ a special makefile." nil nil) + "Target class for a group of miscellaneous with a special makefile." nil nil) (autoload 'ede-proj-target-makefile-program "ede/proj-prog" "Target class for building a program." nil nil) (autoload 'ede-proj-target-makefile-archive "ede/proj-archive" @@ -67,7 +67,7 @@ "Target class for a group of lisp files.") (eieio-defclass-autoload 'ede-proj-target-makefile-miscelaneous '(ede-proj-target-makefile) "ede/proj-misc" - "Target class for a group of miscellaneous w/ a special makefile.") + "Target class for a group of miscellaneous with a special makefile.") (eieio-defclass-autoload 'ede-proj-target-makefile-program '(ede-proj-target-makefile-objectcode) "ede/proj-prog" "Target class for building a program.") @@ -543,7 +543,7 @@ Converts all symbols into the objects to be used." (when (slot-exists-p obj 'compiler) (let ((comp (oref obj compiler))) (if comp - ;; Now that we have a pre-set compilers to use, convert tye symbols + ;; Now that we have a pre-set compilers to use, convert type symbols ;; into objects for ease of use (setq comp (if (listp comp) (mapcar #'symbol-value comp) diff --git a/lisp/cedet/ede/project-am.el b/lisp/cedet/ede/project-am.el index de6936ad1a8..75fde2043cb 100644 --- a/lisp/cedet/ede/project-am.el +++ b/lisp/cedet/ede/project-am.el @@ -195,7 +195,7 @@ other meta-variable based on this name.") "Add the current buffer into a project. _FILE is ignored. OT is the object target. DIR is the directory to start in." - (let* ((target (if ede-object (error "Already associated w/ a target") + (let* ((target (if ede-object (error "Already associated with a target") (let ((amf (project-am-load default-directory))) (if (not amf) (error "No project file")) (completing-read "Target: " @@ -231,7 +231,7 @@ OT is the object target. DIR is the directory to start in." (setq ede-object nil)) (cl-defmethod project-edit-file-target ((obj project-am-target)) - "Edit the target associated w/ this file." + "Edit the target associated with this file." (find-file (concat (oref obj path) "Makefile.am")) (goto-char (point-min)) (makefile-move-to-macro (project-am-macro obj)) diff --git a/lisp/cedet/semantic.el b/lisp/cedet/semantic.el index 3166279de40..adb47056201 100644 --- a/lisp/cedet/semantic.el +++ b/lisp/cedet/semantic.el @@ -186,13 +186,13 @@ during a flush when the cache is given a new value of nil.") "State of the current parse tree.") (defmacro semantic-parse-tree-unparseable () - "Indicate that the current buffer is unparseable. + "Indicate that the current buffer is unparsable. It is also true that the parse tree will need either updating or a rebuild. This state will be changed when the user edits the buffer." '(setq semantic-parse-tree-state 'unparseable)) (defmacro semantic-parse-tree-unparseable-p () - "Return non-nil if the current buffer has been marked unparseable." + "Return non-nil if the current buffer has been marked unparsable." '(eq semantic-parse-tree-state 'unparseable)) (defmacro semantic-parse-tree-set-needs-update () @@ -528,14 +528,14 @@ If the buffer cache is out of date, attempt an incremental reparse. If the buffer has not been parsed before, or if the incremental reparse fails, then parse the entire buffer. If a lexical error had been previously discovered and the buffer -was marked unparseable, then do nothing, and return the cache." +was marked unparsable, then do nothing, and return the cache." (and ;; Is this a semantic enabled buffer? (semantic-active-p) ;; Application hooks say the buffer is safe for parsing (run-hook-with-args-until-failure 'semantic--before-fetch-tags-hook) - ;; If the buffer was previously marked unparseable, + ;; If the buffer was previously marked unparsable, ;; then don't waste our time. (not (semantic-parse-tree-unparseable-p)) ;; The parse tree actually needs to be refreshed @@ -606,7 +606,7 @@ Does nothing if the current buffer doesn't need reparsing." ;; do them here, then all the bovination hooks are not run, and ;; we save lots of time. (cond - ;; If the buffer was previously marked unparseable, + ;; If the buffer was previously marked unparsable, ;; then don't waste our time. ((semantic-parse-tree-unparseable-p) nil) diff --git a/lisp/cedet/semantic/analyze/fcn.el b/lisp/cedet/semantic/analyze/fcn.el index 7f601621156..ef372b5d8b2 100644 --- a/lisp/cedet/semantic/analyze/fcn.el +++ b/lisp/cedet/semantic/analyze/fcn.el @@ -67,12 +67,12 @@ Return the string representing the compound name.") "For a SEQUENCE of tags, all with good names, pick the best one. If SEQUENCE is made up of namespaces, merge the namespaces together. If SEQUENCE has several prototypes, find the non-prototype. -If SEQUENCE has some items w/ no type information, find the one with a type. +If SEQUENCE has some items with no type information, find the one with a type. If SEQUENCE is all prototypes, or has no prototypes, get the first one. Optional TAGCLASS indicates to restrict the return to only tags of TAGCLASS." - ;; If there is a srew up and we get just one tag.. massage over it. + ;; If there is a screw up and we get just one tag.. massage over it. (when (semantic-tag-p sequence) (setq sequence (list sequence))) diff --git a/lisp/cedet/semantic/bovine/c.el b/lisp/cedet/semantic/bovine/c.el index d4ce20589e6..5e08413a96d 100644 --- a/lisp/cedet/semantic/bovine/c.el +++ b/lisp/cedet/semantic/bovine/c.el @@ -1344,7 +1344,7 @@ Optional argument STAR and REF indicate the number of * and & in the typedef." :reentrant-flag (if (member "reentrant" (nth 6 tokenpart)) t) ;; A function post-const is funky. Try stuff :methodconst-flag (if (member "const" (nth 6 tokenpart)) t) - ;; prototypes are functions w/ no body + ;; prototypes are functions with no body :prototype-flag (if (nth 8 tokenpart) t) ;; Pure virtual :pure-virtual-flag (if (eq (nth 8 tokenpart) :pure-virtual-flag) t) @@ -2015,7 +2015,7 @@ have to be wrapped in that namespace." (setq txt (concat txt (format "%S" arg))) (setq sv (cdr sv))) - ;; This is optional, and potentially fraught w/ errors. + ;; This is optional, and potentially fraught with errors. (condition-case nil (dolist (lt sv) (setq txt (concat txt " " (semantic-lex-token-text lt)))) diff --git a/lisp/cedet/semantic/complete.el b/lisp/cedet/semantic/complete.el index dc270603a0c..00fe081acb5 100644 --- a/lisp/cedet/semantic/complete.el +++ b/lisp/cedet/semantic/complete.el @@ -667,7 +667,7 @@ Similar to `minibuffer-contents' when completing in the minibuffer." ) (delete-overlay semantic-complete-inline-overlay) (setq semantic-complete-inline-overlay nil) - ;; DONT restore the window configuration if we just + ;; DON'T restore the window configuration if we just ;; switched windows! (when (eq buf (current-buffer)) (set-window-configuration wc)) diff --git a/lisp/cedet/semantic/db-ebrowse.el b/lisp/cedet/semantic/db-ebrowse.el index f0e1d9f0294..fa608c7c461 100644 --- a/lisp/cedet/semantic/db-ebrowse.el +++ b/lisp/cedet/semantic/db-ebrowse.el @@ -275,7 +275,7 @@ For instance: /home/<username>/.semanticdb/!usr!include!BROWSE" (let ((ans nil) (efcn (symbol-function 'ebrowse-show-progress))) (fset 'ebrowse-show-progress (lambda (&rest _junk) nil)) - (unwind-protect ;; Protect against errors w/ ebrowse + (unwind-protect ; Protect against errors with ebrowse (setq ans (list B (ebrowse-read))) ;; These items must always happen (erase-buffer) diff --git a/lisp/cedet/semantic/db-find.el b/lisp/cedet/semantic/db-find.el index 3012af41c55..e9d5aaa1777 100644 --- a/lisp/cedet/semantic/db-find.el +++ b/lisp/cedet/semantic/db-find.el @@ -1277,7 +1277,7 @@ associated with that tag should be loaded into a buffer." ;;; Specialty Search Routines (defun semanticdb-find-tags-external-children-of-type (type &optional path find-file-match) - "Search for all tags defined outside of TYPE w/ TYPE as a parent. + "Search for all tags defined outside of TYPE with TYPE as a parent. See `semanticdb-find-translate-path' for details on PATH. FIND-FILE-MATCH indicates that any time a match is found, the file associated with that tag should be loaded into a buffer." diff --git a/lisp/cedet/semantic/decorate/include.el b/lisp/cedet/semantic/decorate/include.el index 144e2ce0187..fe510c371e3 100644 --- a/lisp/cedet/semantic/decorate/include.el +++ b/lisp/cedet/semantic/decorate/include.el @@ -330,7 +330,7 @@ This mode provides a nice context menu on the include statements." ) )) - ;; @TODO - if not a tag w/ a position, we need to get one. How? + ;; @TODO - if not a tag with a position, we need to get one. How? (when (semantic-tag-with-position-p tag) (let ((ol (semantic-decorate-tag tag diff --git a/lisp/cedet/semantic/edit.el b/lisp/cedet/semantic/edit.el index 4efc283520f..d752ecdf38a 100644 --- a/lisp/cedet/semantic/edit.el +++ b/lisp/cedet/semantic/edit.el @@ -40,7 +40,7 @@ ;; of themselves that can be edited w/out affecting the definition of ;; that tag. ;; -;; 2. Tags w/ positioned children could have a property of an +;; 2. Tags with positioned children could have a property of an ;; overlay marking the region in themselves that contain the ;; children. This could be used to better improve splicing near ;; the beginning and end of the child lists. diff --git a/lisp/cedet/semantic/grm-wy-boot.el b/lisp/cedet/semantic/grm-wy-boot.el index 376fab89c23..7fff36a3d02 100644 --- a/lisp/cedet/semantic/grm-wy-boot.el +++ b/lisp/cedet/semantic/grm-wy-boot.el @@ -396,12 +396,12 @@ (let ((s $1)) (if - (string-match "^{[
\n ]*" s) + (string-match "^{[\^M\n ]*" s) (setq s (substring s (match-end 0)))) (if - (string-match "[
\n ]*}$" s) + (string-match "[\^M\n ]*}$" s) (setq s (substring s 0 (match-beginning 0)))) diff --git a/lisp/cedet/semantic/idle.el b/lisp/cedet/semantic/idle.el index 2d6f26919d7..e53dd9104ad 100644 --- a/lisp/cedet/semantic/idle.el +++ b/lisp/cedet/semantic/idle.el @@ -396,7 +396,7 @@ Uses `semantic-idle-work-for-on-buffer' to do the work." (semanticdb-save-all-db-idle) ) - ;; Done w/ processing + ;; Done with processing nil)))) ;; Done diff --git a/lisp/cedet/semantic/scope.el b/lisp/cedet/semantic/scope.el index 83e7ed66c13..45964a1a17d 100644 --- a/lisp/cedet/semantic/scope.el +++ b/lisp/cedet/semantic/scope.el @@ -577,7 +577,7 @@ such as `public' or `private'." (if (semantic-tag-file-name TAG) ;; If it has a filename, just go with it... (setq copyslots (cons TAG copyslots)) - ;; Otherwise, copy the tag w/ the guessed filename. + ;; Otherwise, copy the tag with the guessed filename. (setq copyslots (cons (semantic-tag-copy TAG nil fname) copyslots))) ) @@ -822,7 +822,7 @@ hits in order, with the first tag being in the closest scope." ans) ;; Not a real scope. Our scope calculation analyze parts of ;; what it finds, and needs to pass lists through to do it's work. - ;; Tread that list as a singly entry. + ;; Treat that list as a singly entry. (if class (semantic-find-tags-by-class class scope) scope) diff --git a/lisp/cedet/semantic/symref/list.el b/lisp/cedet/semantic/symref/list.el index eacbb6f1f8e..1cb5d5b04a7 100644 --- a/lisp/cedet/semantic/symref/list.el +++ b/lisp/cedet/semantic/symref/list.el @@ -51,7 +51,7 @@ Display the references in `semantic-symref-results-mode'." (let ((ct (semantic-current-tag))) ;; Must have a tag... (when (not ct) (error "Place cursor inside tag to be searched for")) - ;; Check w/ user. + ;; Check with user. (when (not (y-or-n-p (format "Find references for %s? " (semantic-tag-name ct)))) (error "Quit")) @@ -378,7 +378,8 @@ BUTTON is the button that was clicked." (defun semantic-symref-list-on-hit-p () "Return the line number if the cursor is on a buffer line with a hit. -Hits are the line of code from the buffer, not the tag summar or file lines." +Hits are the line of code from the buffer, not the tag summary or +file lines." (save-excursion (end-of-line) (let* ((ol (car (overlays-at (1- (point)))))) ;; trust this for now diff --git a/lisp/cedet/semantic/tag.el b/lisp/cedet/semantic/tag.el index 16695a108a6..aa5b17e9bb7 100644 --- a/lisp/cedet/semantic/tag.el +++ b/lisp/cedet/semantic/tag.el @@ -1176,7 +1176,7 @@ This function is for internal use only." (defsubst semantic--tag-expanded-p (tag) "Return non-nil if TAG is expanded. This function is for internal use only. -See also the function `semantic--expand-tag'." +See also the function `semantic--tag-expand'." ;; In fact a cooked tag is actually a list of cooked tags ;; because a raw tag can be expanded in several cooked ones! (when (consp tag) diff --git a/lisp/cedet/semantic/util-modes.el b/lisp/cedet/semantic/util-modes.el index 96d1de5a26c..bcded23aec6 100644 --- a/lisp/cedet/semantic/util-modes.el +++ b/lisp/cedet/semantic/util-modes.el @@ -133,7 +133,7 @@ symbol whose value is such a string." semantic-minor-mode-alist)))) (semantic-mode-line-update) - ;; Semantic minor modes don't work w/ Desktop restore. + ;; Semantic minor modes don't work with Desktop restore. ;; This line will disable this minor mode from being restored ;; by Desktop. (when (boundp 'desktop-minor-mode-handlers) diff --git a/lisp/cedet/srecode/document.el b/lisp/cedet/srecode/document.el index a25d1441f1f..c264ebaa70a 100644 --- a/lisp/cedet/srecode/document.el +++ b/lisp/cedet/srecode/document.el @@ -29,7 +29,8 @@ ;; ;;; Origins: ;; -;; Document was first written w/ cparse, a custom regexp based c parser. +;; Document was first written with cparse, a custom regexp based c +;; parser. ;; ;; Document was then ported to cedet/semantic using sformat (super ;; format) as the templating engine. diff --git a/lisp/cedet/srecode/extract.el b/lisp/cedet/srecode/extract.el index 7d4539dcb42..f218f1c6e9d 100644 --- a/lisp/cedet/srecode/extract.el +++ b/lisp/cedet/srecode/extract.el @@ -219,7 +219,7 @@ Return nil if nothing was extracted." ;; With a name, do the insertion. (let ((subdict (srecode-dictionary-add-section-dictionary dict (oref ins object-name)))) - (error "Need to implement include w/ name extractor") + (error "Need to implement include with name extractor") ;; Recurse into the new template while no errors. (while (condition-case nil (progn diff --git a/lisp/cedet/srecode/semantic.el b/lisp/cedet/srecode/semantic.el index ea7fda004e7..c5ceb89d2dc 100644 --- a/lisp/cedet/srecode/semantic.el +++ b/lisp/cedet/srecode/semantic.el @@ -43,8 +43,8 @@ ;;; The SEMANTIC TAG inserter ;; -;; Put a tag into the dictionary that can be used w/ arbitrary -;; lisp expressions. +;; Put a tag into the dictionary that can be used with arbitrary +;; Lisp expressions. (defclass srecode-semantic-tag (srecode-dictionary-compound-value) ((prime :initarg :prime diff --git a/lisp/comint.el b/lisp/comint.el index 07ced8d321a..93b97cb22b4 100644 --- a/lisp/comint.el +++ b/lisp/comint.el @@ -604,6 +604,14 @@ via PTYs.") menu-bar-final-items)) map)) +(defvar-keymap comint-repeat-map + :doc "Keymap to repeat comint key sequences. Used in `repeat-mode'." + "C-n" #'comint-next-prompt + "C-p" #'comint-previous-prompt) + +(put #'comint-next-prompt 'repeat-map 'comint-repeat-map) +(put #'comint-previous-prompt 'repeat-map 'comint-repeat-map) + ;; Fixme: Is this still relevant? (defvar comint-ptyp t "Non-nil if communications via pty; false if by pipe. Buffer local. diff --git a/lisp/cus-theme.el b/lisp/cus-theme.el index b891f241549..0260ad4a50e 100644 --- a/lisp/cus-theme.el +++ b/lisp/cus-theme.el @@ -32,17 +32,15 @@ (eval-when-compile (require 'wid-edit)) -(defvar custom-new-theme-mode-map - (let ((map (make-keymap))) - (set-keymap-parent map (make-composed-keymap widget-keymap - special-mode-map)) - (suppress-keymap map) - (define-key map "\C-x\C-s" 'custom-theme-write) - (define-key map "q" 'Custom-buffer-done) - (define-key map "n" 'widget-forward) - (define-key map "p" 'widget-backward) - map) - "Keymap for `custom-new-theme-mode'.") +(defvar-keymap custom-new-theme-mode-map + :doc "Keymap for `custom-new-theme-mode'." + :full t + :suppress t + :parent (make-composed-keymap widget-keymap special-mode-map) + "C-x C-s" #'custom-theme-write + "q" #'Custom-buffer-done + "n" #'widget-forward + "p" #'widget-backward) (define-derived-mode custom-new-theme-mode nil "Custom-Theme" "Major mode for editing Custom themes. @@ -534,17 +532,15 @@ It includes all faces in list FACES." :type 'boolean :group 'custom-buffer) -(defvar custom-theme-choose-mode-map - (let ((map (make-keymap))) - (set-keymap-parent map (make-composed-keymap widget-keymap - special-mode-map)) - (suppress-keymap map) - (define-key map "\C-x\C-s" 'custom-theme-save) - (define-key map "n" 'widget-forward) - (define-key map "p" 'widget-backward) - (define-key map "?" 'custom-describe-theme) - map) - "Keymap for `custom-theme-choose-mode'.") +(defvar-keymap custom-theme-choose-mode-map + :doc "Keymap for `custom-theme-choose-mode'." + :full t + :suppress t + :parent (make-composed-keymap widget-keymap special-mode-map) + "C-x C-s" #'custom-theme-save + "n" #'widget-forward + "p" #'widget-backward + "?" #'custom-describe-theme) (define-derived-mode custom-theme-choose-mode special-mode "Themes" "Major mode for selecting Custom themes. diff --git a/lisp/dired.el b/lisp/dired.el index 209e270942b..81e62f88cf1 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -1541,7 +1541,7 @@ BEG..END is the line where the file info is located." (when (< alt-col other-col) (setq other-col alt-col) (setq other (point))))) - ;; Keep positions uptodate when we insert stuff. + ;; Keep positions up-to-date when we insert stuff. (if (> other file) (setq other (copy-marker other))) (setq file (copy-marker file)) ;; Main loop. @@ -3028,13 +3028,13 @@ See options: `dired-hide-details-hide-symlink-targets' and ;; The old code used selective-display which only works at ;; a line-granularity, so it used start and end positions that where ;; approximate ("anywhere on the line is fine"). - ;; FIXME: This also removes other invisible properties! (save-excursion (let ((inhibit-read-only t)) (remove-list-of-text-properties (progn (goto-char start) (line-end-position)) (progn (goto-char end) (line-end-position)) - '(invisible))))) + '(invisible)) + (dired-insert-set-properties start end)))) ;;; Functions for finding the file name in a dired buffer line diff --git a/lisp/dnd.el b/lisp/dnd.el index b2e93a63def..7708695346f 100644 --- a/lisp/dnd.el +++ b/lisp/dnd.el @@ -325,7 +325,7 @@ in that list instead." (defun dnd-begin-text-drag (text &optional frame action allow-same-frame) "Begin dragging TEXT from FRAME. -Initate a drag-and-drop operation allowing the user to drag text +Initiate a drag-and-drop operation allowing the user to drag text from Emacs to another program (the drop target), then block until the drop is completed or is canceled. @@ -381,7 +381,7 @@ currently being held down. It should only be called upon a (defun dnd-begin-file-drag (file &optional frame action allow-same-frame) "Begin dragging FILE from FRAME. -Initate a drag-and-drop operation allowing the user to drag a file +Initiate a drag-and-drop operation allowing the user to drag a file from Emacs to another program (the drop target), then block until the drop happens or is canceled. diff --git a/lisp/dynamic-setting.el b/lisp/dynamic-setting.el index 8ac9a1e9e6a..ee6d1ceb358 100644 --- a/lisp/dynamic-setting.el +++ b/lisp/dynamic-setting.el @@ -51,19 +51,11 @@ the current form for the frame (i.e. hinting or somesuch changed)." ;; Set the font on all current and future frames, as though ;; the `default' face had been "set for this session": (set-frame-font new-font nil frame-list) - ;; Just redraw the existing fonts on all frames: - (dolist (f frame-list) - (let ((frame-font - (or (font-get (face-attribute 'default :font f 'default) - :user-spec) - (frame-parameter f 'font-parameter)))) - (when frame-font - (set-frame-parameter f 'font-parameter frame-font) - (set-face-attribute 'default f - :width 'normal - :weight 'normal - :slant 'normal - :font frame-font)))))))) + ;; Just reconsider the existing fonts on all frames on each + ;; display, by clearing the font and face caches. This will + ;; cause all fonts to be recreated. + (dolist (frame frame-list) + (reconsider-frame-fonts frame)))))) (defun dynamic-setting-handle-config-changed-event (event) "Handle config-changed-event on the display in EVENT. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 4d258dab96e..f176e769bf5 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1941,11 +1941,10 @@ also be compiled." ;; This file is a subdirectory. Handle them differently. (or (null arg) (eq 0 arg) (y-or-n-p (concat "Check " source "? "))) - (setq directories (nconc directories (list source))) ;; Directory is requested to be ignored - (string-match-p - (regexp-opt byte-compile-ignore-files) - source) + (not (string-match-p + (regexp-opt byte-compile-ignore-files) + source)) (setq directories (nconc directories (list source)))) ;; It is an ordinary file. Decide whether to compile it. (if (and (string-match emacs-lisp-file-regexp source) @@ -1955,9 +1954,9 @@ also be compiled." (not (auto-save-file-name-p source)) (not (member source (dir-locals--all-files directory))) ;; File is requested to be ignored - (string-match-p - (regexp-opt byte-compile-ignore-files) - source)) + (not (string-match-p + (regexp-opt byte-compile-ignore-files) + source))) (progn (cl-incf (pcase (byte-recompile-file source force arg) ('no-byte-compile skip-count) @@ -3638,7 +3637,7 @@ lambda-expression." (byte-compile-out base-op tmp))) (defun byte-compile-dynamic-variable-bind (var) - "Generate code to bind the lexical variable VAR to the top-of-stack value." + "Generate code to bind the dynamic variable VAR to the top-of-stack value." (byte-compile-check-variable var 'let-bind) (push var byte-compile-bound-variables) (byte-compile-dynamic-variable-op 'byte-varbind var)) diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el index 3f9bc28e0b0..3bddb93b64a 100644 --- a/lisp/emacs-lisp/checkdoc.el +++ b/lisp/emacs-lisp/checkdoc.el @@ -2265,8 +2265,8 @@ buffer, otherwise stop after the first error." (unless (and sym (or (boundp sym) (fboundp sym))) ;; Find out how we spell-check this word. (unless (or - ;; All caps w/ option th, or s tacked on the end - ;; for pluralization or number. + ;; All caps with option th, or s tacked on the + ;; end for pluralization or number. (string-match "^[A-Z][A-Z]+\\(s\\|th\\)?$" word) (looking-at "}") ; a keymap expression ) diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index beafee1d631..43a2ed92059 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -656,6 +656,8 @@ its argument list allows full Common Lisp conventions." (check `(while ,var (cond ((memq (car ,var) ',(append keys allow)) + (unless (cdr ,var) + (error "Missing argument for %s" (car ,var))) (setq ,var (cdr (cdr ,var)))) ((car (cdr (memq (quote ,@allow) ,restarg))) (setq ,var nil)) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index 863e895efdb..0ee094c34d8 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -2823,7 +2823,7 @@ blocks." (first-processed (l) (if-let ((p (cl-find-if (lambda (p) (comp-block-idom p)) l))) p - (signal 'native-ice "cant't find first preprocessed")))) + (signal 'native-ice "can't find first preprocessed")))) (when-let ((blocks (comp-func-blocks comp-func)) (entry (gethash 'entry blocks)) @@ -4358,6 +4358,6 @@ of (commands) to run simultaneously." (provide 'comp) -;; LocalWords: limplified limplified limplification limplify Limple LIMPLE libgccjit elc eln +;; LocalWords: limplified limplification limplify Limple LIMPLE libgccjit elc eln ;;; comp.el ends here diff --git a/lisp/emacs-lisp/ert-x.el b/lisp/emacs-lisp/ert-x.el index a891f068a70..49f2a1d6965 100644 --- a/lisp/emacs-lisp/ert-x.el +++ b/lisp/emacs-lisp/ert-x.el @@ -560,6 +560,7 @@ The same keyword arguments are supported as in '("mock" (tramp-login-program "sh") (tramp-login-args (("-i"))) + (tramp-direct-async ("-c")) (tramp-remote-shell "/bin/sh") (tramp-remote-shell-args ("-c")) (tramp-connection-timeout 10))) diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 047b0069bb9..c25ade22d6f 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -208,7 +208,7 @@ is run. If a macro (possibly with side effects) is to be tested, it has to be wrapped in `(eval (quote ...))'. If NAME is already defined as a test and Emacs is running -in batch mode, an error is signalled. +in batch mode, an error is signaled. \(fn NAME () [DOCSTRING] [:expected-result RESULT-TYPE] \ [:tags \\='(TAG...)] BODY...)" diff --git a/lisp/emacs-lisp/hierarchy.el b/lisp/emacs-lisp/hierarchy.el index fb5d518b22d..d955019a9db 100644 --- a/lisp/emacs-lisp/hierarchy.el +++ b/lisp/emacs-lisp/hierarchy.el @@ -191,7 +191,7 @@ PARENTFN, CHILDRENFN, ACCEPTFN, and DELAY-CHILDREN-P have the same meaning as in (defun hierarchy-add-list (hierarchy list &optional wrap childrenfn) "Add to HIERARCHY the sub-lists in LIST. -If WRAP is non-nil, allow duplicate items in LIST by wraping each +If WRAP is non-nil, allow duplicate items in LIST by wrapping each item in a cons (id . item). The root's id is 1. CHILDRENFN is a function (defaults to `cdr') taking LIST as a diff --git a/lisp/emacs-lisp/package-vc.el b/lisp/emacs-lisp/package-vc.el index a0b4b03118d..a999596785b 100644 --- a/lisp/emacs-lisp/package-vc.el +++ b/lisp/emacs-lisp/package-vc.el @@ -39,6 +39,9 @@ ;; - Allow maintaining patches that are ported back onto regular ;; packages and maintained between versions. +;; +;; - Add a heuristic for guessing a `:lisp-dir' when cloning directly +;; from a URL. ;;; Code: @@ -49,7 +52,6 @@ (require 'lisp-mnt) (require 'vc) (require 'seq) -(require 'xdg) (defgroup package-vc nil "Manage packages from VC checkouts." @@ -100,12 +102,6 @@ vc-handled-backends))) :version "29.1") -(defcustom package-vc-repository-store - (expand-file-name "emacs/vc-packages" (xdg-data-home)) - "Directory used by `package-vc--unpack' to store repositories." - :type 'directory - :version "29.1") - (defcustom package-vc-default-backend 'Git "Default VC backend used when cloning a package repository. If no repository type was specified or could be guessed by @@ -118,13 +114,16 @@ the `clone' function." :version "29.1") (defvar package-vc-selected-packages) ; pacify byte-compiler -(defun package-vc-ensure-packages () + +;;;###autoload +(defun package-vc-install-selected-packages () "Ensure packages specified in `package-vc-selected-packages' are installed." - (pcase-dolist (`(,(and (pred symbolp) name) . ,spec) - package-vc-selected-packages) - (let ((pkg-desc (cadr (assoc name package-alist #'string=)))) - (unless (and name (package-installed-p name) - (package-vc-p pkg-desc)) + (interactive) + (pcase-dolist (`(,name . ,spec) package-vc-selected-packages) + (when (stringp name) + (setq name (intern name))) + (let ((pkg-descs (assoc name package-alist #'string=))) + (unless (seq-some #'package-vc-p (cdr pkg-descs)) (cond ((null spec) (package-vc-install name)) @@ -132,7 +131,7 @@ the `clone' function." (package-vc-install name nil spec)) ((listp spec) (package-vc--archives-initialize) - (package-vc--unpack pkg-desc spec))))))) + (package-vc--unpack (cadr pkg-descs) spec))))))) ;;;###autoload (defcustom package-vc-selected-packages '() @@ -142,13 +141,40 @@ is a symbol designating the package and SPEC is one of: - nil, if any package version can be installed; - a version string, if that specific revision is to be installed; -- a property list of the form described in - `package-vc-archive-spec-alist', giving a package - specification. +- a property list, describing a package specification. Valid + key/value pairs are + + `:url' (string) + The URL of the repository used to fetch the package source. + + `:branch' (string) + If given, the name of the branch to checkout after cloning the directory. + + `:lisp-dir' (string) + The repository-relative name of the directory to use for loading the Lisp + sources. If not given, the value defaults to the root directory + of the repository. + + `:main-file' (string) + The main file of the project, relevant to gather package metadata. + If not given, the assumed default is the package name with \".el\" + appended to it. + + `:vc-backend' (symbol) + A symbol of the VC backend to use for cloning the package. The + value ought to be a member of `vc-handled-backends'. If omitted, + `vc-clone' will fall back onto the archive default or on + `package-vc-default-backend'. + + All other keys are ignored. This user option differs from `package-selected-packages' in that -it is meant to be specified manually. You can also use the -function `package-vc-selected-packages' to apply the changes." +it is meant to be specified manually. If you want to install all +the packages in the list, you cal also use +`package-vc-install-selected-packages'. + +Note that this option will not override an existing source +package installation or revert the checked out revision." :type '(alist :tag "List of packages you want to be installed" :key-type (symbol :tag "Package") :value-type @@ -159,39 +185,16 @@ function `package-vc-selected-packages' to apply the changes." (:lisp-dir string) (:main-file string) (:vc-backend symbol))))) + :initialize #'custom-initialize-default :set (lambda (sym val) (custom-set-default sym val) - (package-vc-ensure-packages)) + (package-vc-install-selected-packages)) :version "29.1") (defvar package-vc--archive-spec-alist nil "List of package specifications for each archive. -The list maps each package name, as a string, to a plist. -Valid keys and the corresponding value types are: - - `:url' (string) - The URL of the repository used to fetch the package source. - - `:branch' (string) - If given, the name of the branch to checkout after cloning the directory. - - `:lisp-dir' (string) - The repository-relative name of the directory to use for loading the Lisp - sources. If not given, the value defaults to the root directory - of the repository. - - `:main-file' (string) - The main file of the project, relevant to gather package metadata. - If not given, the assumed default is the package name with \".el\" - appended to it. - - `:vc-backend' (symbol) - A symbol of the VC backend to use for cloning the package. The - value ought to be a member of `vc-handled-backends'. If omitted, - `vc-clone' will fall back onto the archive default or on - `package-vc-default-backend'. - -All other values are ignored.") +The list maps each package name, as a string, to a plist as +specified in `package-vc-selected-packages'.") (defvar package-vc--archive-data-alist nil "List of package specification metadata for archives. @@ -219,7 +222,7 @@ name for PKG-DESC." (if (package-desc-archive pkg-desc) (alist-get (intern (package-desc-archive pkg-desc)) package-vc--archive-spec-alist) - (mapcan #'append (mapcar #'cdr package-vc--archive-spec-alist))) + (apply #'append (mapcar #'cdr package-vc--archive-spec-alist))) nil nil #'string=)) (define-inline package-vc--query-spec (pkg-desc prop) @@ -231,7 +234,7 @@ return nil." (defun package-vc--read-archive-data (archive) "Update `package-vc--archive-spec-alist' for ARCHIVE. -This function is meant to be used as a hook for `package--read-archive-hook'." +This function is meant to be used as a hook for `package-read-archive-hook'." (let ((contents-file (expand-file-name (format "archives/%s/elpa-packages.eld" archive) package-user-dir))) @@ -268,7 +271,6 @@ asynchronously." (error (message "Failed to download `%s' archive." (car archive)))))) (add-hook 'package-read-archive-hook #'package-vc--read-archive-data 20) -(add-hook 'package-refresh-contents-hook #'package-vc--download-and-read-archives 20) (defun package-vc-commit (pkg) "Return the last commit of a development package PKG." @@ -282,7 +284,7 @@ asynchronously." finally return "unknown")) (defun package-vc--version (pkg) - "Extract the commit of a development package PKG." + "Return the version number for the source package PKG." (cl-assert (package-vc-p pkg)) (if-let ((main-file (package-vc--main-file pkg))) (with-temp-buffer @@ -295,15 +297,14 @@ asynchronously." (defun package-vc--main-file (pkg-desc) "Return the name of the main file for PKG-DESC." (cl-assert (package-vc-p pkg-desc)) - (let ((pkg-spec (package-vc--desc->spec pkg-desc))) + (let ((pkg-spec (package-vc--desc->spec pkg-desc)) + (name (symbol-name (package-desc-name pkg-desc)))) (or (plist-get pkg-spec :main-file) (expand-file-name - (format "%s.el" (package-desc-name pkg-desc)) + (concat name ".el") (file-name-concat (or (package-desc-dir pkg-desc) - (expand-file-name - (package-desc-name pkg-desc) - package-user-dir)) + (expand-file-name name package-user-dir)) (plist-get pkg-spec :lisp-dir)))))) (defun package-vc--generate-description-file (pkg-desc pkg-file) @@ -351,26 +352,51 @@ asynchronously." (declare-function org-export-to-file "ox" (backend file)) (defun package-vc--build-documentation (pkg-desc file) - "Build documentation FILE for PKG-DESC. + "Build documentation for package PKG-DESC from documentation source in FILE. FILE can be an Org file, indicated by its \".org\" extension, otherwise it's assumed to be an Info file." - (let ((pkg-dir (package-desc-dir pkg-desc))) + (let* ((pkg-name (package-desc-name pkg-desc)) + (default-directory (package-desc-dir pkg-desc)) + (output (expand-file-name (format "%s.info" pkg-name))) + clean-up) (when (string-match-p "\\.org\\'" file) (require 'ox) (require 'ox-texinfo) (with-temp-buffer (insert-file-contents file) (setq file (make-temp-file "ox-texinfo-")) - (org-export-to-file 'texinfo file))) - (call-process "install-info" nil nil nil - file pkg-dir))) + (org-export-to-file 'texinfo file) + (setq clean-up t))) + (with-current-buffer (get-buffer-create " *package-vc doc*") + (erase-buffer) + (cond + ((/= 0 (call-process "makeinfo" nil t nil + "--no-split" file "-o" output)) + (message "Failed to build manual %s, see buffer %S" + file (buffer-name))) + ((/= 0 (call-process "install-info" nil t nil + output (expand-file-name "dir"))) + (message "Failed to install manual %s, see buffer %S" + output (buffer-name))) + ((kill-buffer)))) + (when clean-up + (delete-file file)))) (defun package-vc--unpack-1 (pkg-desc pkg-dir) - "Install PKG-DESC that is already checked-out in PKG-DIR." + "Prepare PKG-DESC that is already checked-out in PKG-DIR. +This includes downloading missing dependencies, generating +autoloads, generating a package description file (used to +identify a package as a source package later on), building +documentation and marking the package as installed." + ;; Remove any previous instance of PKG-DESC from `package-alist' + (let ((pkgs (assq (package-desc-name pkg-desc) package-alist))) + (when pkgs + (setf (cdr pkgs) (seq-remove #'package-vc-p (cdr pkgs))))) + ;; In case the package was installed directly from source, the ;; dependency list wasn't know beforehand, and they might have ;; to be installed explicitly. - (let (deps) + (let ((deps '())) (dolist (file (directory-files pkg-dir t "\\.el\\'" t)) (with-temp-buffer (insert-file-contents file) @@ -387,10 +413,26 @@ otherwise it's assumed to be an Info file." (package-compute-transaction nil (delete-dups deps)))) (let ((default-directory (file-name-as-directory pkg-dir)) - (name (package-desc-name pkg-desc)) (pkg-file (expand-file-name (package--description-file pkg-dir) pkg-dir))) ;; Generate autoloads - (package-generate-autoloads name pkg-dir) + (let* ((name (package-desc-name pkg-desc)) + (auto-name (format "%s-autoloads.el" name)) + (extras (package-desc-extras pkg-desc)) + (lisp-dir (alist-get :lisp-dir extras))) + (package-generate-autoloads + name (file-name-concat pkg-dir lisp-dir)) + (when lisp-dir + (write-region + (with-temp-buffer + (insert ";; Autoload indirection for package-vc\n\n") + (prin1 `(load (expand-file-name + ,(file-name-concat lisp-dir auto-name) + (or (and load-file-name + (file-name-directory load-file-name)) + (car load-path)))) + (current-buffer)) + (buffer-string)) + nil (expand-file-name auto-name pkg-dir)))) ;; Generate package file (package-vc--generate-description-file pkg-desc pkg-file) @@ -474,48 +516,66 @@ PKG-SPEC is a package specification, a property list describing how to fetch and build the package. See `package-vc--archive-spec-alist' for details. The optional argument REV specifies a specific revision to checkout. This overrides the `:branch' attribute in PKG-SPEC." - (pcase-let* (((map :url :lisp-dir) pkg-spec) + (pcase-let* (((map :lisp-dir) pkg-spec) (name (package-desc-name pkg-desc)) (dirname (package-desc-full-name pkg-desc)) - (pkg-dir (expand-file-name dirname package-user-dir)) - (real-dir (if (null lisp-dir) - pkg-dir - (unless (file-exists-p package-vc-repository-store) - (make-directory package-vc-repository-store t)) - (file-name-concat - package-vc-repository-store - ;; FIXME: We aren't sure this directory - ;; will be unique, but we can try other - ;; names to avoid an unnecessary error. - (file-name-base url))))) + (pkg-dir (expand-file-name dirname package-user-dir))) (setf (package-desc-dir pkg-desc) pkg-dir) (when (file-exists-p pkg-dir) (if (yes-or-no-p "Overwrite previous checkout?") - (package--delete-directory pkg-dir pkg-desc) + (package--delete-directory pkg-dir) (error "There already exists a checkout for %s" name))) - (package-vc--clone pkg-desc pkg-spec real-dir rev) - (unless (eq pkg-dir real-dir) - ;; Link from the right position in `repo-dir' to the package - ;; directory in the ELPA store. - (make-symbolic-link (file-name-concat real-dir lisp-dir) pkg-dir)) + (package-vc--clone pkg-desc pkg-spec pkg-dir rev) + (when lisp-dir + (push (cons :lisp-dir lisp-dir) + (package-desc-extras pkg-desc))) (package-vc--unpack-1 pkg-desc pkg-dir))) -(defun package-vc--sourced-packages-list () - "Generate a list of packages with VC data." - (seq-filter - (lambda (pkg) - (or (package-vc--desc->spec (cadr pkg)) - ;; If we have no explicit VC data, we can try a kind of - ;; heuristic and use the URL header, that might already be - ;; pointing towards a repository, and use that as a backup - (and-let* ((extras (package-desc-extras (cadr pkg))) - (url (alist-get :url extras)) - ((package-vc--guess-backend url)))))) - package-archive-contents)) +(defun package-vc--read-package-name (prompt &optional allow-url installed) + "Query the user for a source package and return a name with PROMPT. +If the optional argument ALLOW-URL is non-nil, the user is also +allowed to specify a non-package name. If the optional argument +INSTALLED is non-nil, the selection will be filtered down to +source packages that have already been installed." + (package-vc--archives-initialize) + (completing-read prompt (if installed package-alist package-archive-contents) + (if installed + (lambda (pkg) (package-vc-p (cadr pkg))) + (lambda (pkg) + (or (package-vc--desc->spec (cadr pkg)) + ;; If we have no explicit VC data, we can try a kind of + ;; heuristic and use the URL header, that might already be + ;; pointing towards a repository, and use that as a backup + (and-let* ((extras (package-desc-extras (cadr pkg))) + (url (alist-get :url extras)) + ((package-vc--guess-backend url))))))) + (not allow-url))) + +(defun package-vc--read-package-desc (prompt &optional installed) + "Query the user for a source package and return a description with PROMPT. +If the optional argument INSTALLED is non-nil, the selection will +be filtered down to source packages that have already been +installed, and the package description will be that of an +installed package." + (cadr (assoc (package-vc--read-package-name prompt nil installed) + (if installed package-alist package-archive-contents) + #'string=))) + +;;;###autoload +(defun package-vc-update-all () + "Attempt to update all installed VC packages." + (interactive) + (dolist (package package-alist) + (dolist (pkg-desc (cdr package)) + (when (package-vc-p pkg-desc) + (package-vc-update pkg-desc)))) + (message "Done updating packages.")) +;;;###autoload (defun package-vc-update (pkg-desc) "Attempt to update the package PKG-DESC." + (interactive (list (package-vc--read-package-desc "Update source package: " t))) ;; HACK: To run `package-vc--unpack-1' after checking out the new ;; revision, we insert a hook into `vc-post-command-functions', and ;; remove it right after it ran. To avoid running the hook multiple @@ -528,26 +588,25 @@ checkout. This overrides the `:branch' attribute in PKG-SPEC." ;; `package-vc--unpack-1'. Ugh... ;; ;; If there is a better way to do this, it should be done. + (cl-assert (package-vc-p pkg-desc)) (letrec ((pkg-dir (package-desc-dir pkg-desc)) - (empty (make-symbol empty)) - (args (list empty empty empty)) + (vc-flags) (vc-filter-command-function (lambda (command file-or-list flags) - (setf (nth 0 args) command - (nth 1 args) file-or-list - (nth 2 args) flags) + (setq vc-flags flags) (list command file-or-list flags))) (post-upgrade - (lambda (command file-or-list flags) - (when (and (memq (nth 0 args) (list command empty)) - (memq (nth 1 args) (list file-or-list empty)) - (memq (nth 2 args) (list flags empty))) - (with-demoted-errors "Failed to activate: %S" - (package-vc--unpack-1 pkg-desc pkg-dir)) - (remove-hook 'vc-post-command-functions post-upgrade))))) + (lambda (_command _file-or-list flags) + (when (and (file-equal-p pkg-dir default-directory) + (eq flags vc-flags)) + (unwind-protect + (with-demoted-errors "Failed to activate: %S" + (package-vc--unpack-1 pkg-desc pkg-dir)) + (remove-hook 'vc-post-command-functions post-upgrade)))))) (add-hook 'vc-post-command-functions post-upgrade) (with-demoted-errors "Failed to fetch: %S" - (vc-pull)))) + (let ((default-directory pkg-dir)) + (vc-pull))))) (defun package-vc--archives-initialize () "Initialize package.el and fetch package specifications." @@ -577,46 +636,60 @@ If no such revision can be found, return nil." (line-number-at-pos nil t)))))))) ;;;###autoload -(defun package-vc-install (name-or-url &optional name rev backend) - "Fetch a package NAME-OR-URL and set it up for using with Emacs. -If NAME-OR-URL is a URL, download the package from the repository -at that URL; the function will try to guess the name of the package -from the URL. Otherwise NAME-OR-URL should be a symbol whose name -is the package name, and the URL for the package will be taken from -the package's metadata. +(defun package-vc-install (package &optional name rev backend) + "Fetch a PACKAGE and set it up for using with Emacs. + +If PACKAGE is a string containing an URL, download the package +from the repository at that URL; the function will try to guess +the name of the package from the URL. This can be overridden by +passing the optional argument NAME. If PACKAGE is a cons-cell, +it should have the form (NAME . SPEC), where NAME is a symbol +indicating the package name and SPEC is a plist as described in +`package-vc-selected-packages'. Otherwise PACKAGE should be a +symbol whose name is the package name, and the URL for the +package will be taken from the package's metadata. + By default, this function installs the last version of the package available from its repository, but if REV is given and non-nil, it specifies the revision to install. If REV has the special value `:last-release' (interactively, the prefix argument), that stands for the last released version of the package. -When calling from Lisp, optional argument NAME overrides the package -name as deduced from NAME-OR-URL. + Optional argument BACKEND specifies the VC backend to use for cloning the package's repository; this is only possible if NAME-OR-URL is a URL, a string. If BACKEND is omitted or nil, the function -uses `package-vc--guess-backend' to guess the backend." +uses `package-vc-heuristic-alist' to guess the backend. +Note that by default, a source package will be prioritized over a +regular package, but it will not remove a source package." (interactive (progn ;; Initialize the package system to get the list of package ;; symbols for completion. (package-vc--archives-initialize) - (let* ((packages (package-vc--sourced-packages-list)) - (input (completing-read - "Fetch package source (name or URL): " packages)) - (name (file-name-base input))) - (list input (intern (string-remove-prefix "emacs-" name)) + (let* ((name-or-url (package-vc--read-package-name + "Fetch and install package: " t)) + (name (file-name-base name-or-url))) + (list name-or-url (intern (string-remove-prefix "emacs-" name)) (and current-prefix-arg :last-release))))) (package-vc--archives-initialize) (cond - ((and-let* (((stringp name-or-url)) - (backend (or backend (package-vc--guess-backend name-or-url)))) + ((null package) + (signal 'wrong-type-argument nil)) + ((consp package) + (package-vc--unpack + (package-desc-create :name (car package) + :kind 'vc) + (cdr package) + rev)) + ((and-let* (((stringp package)) + (backend (or backend (package-vc--guess-backend package)))) (package-vc--unpack (package-desc-create - :name (or name (intern (file-name-base name-or-url))) + :name (or name (intern (file-name-base package))) :kind 'vc) - (list :vc-backend backend :url name-or-url) + (list :vc-backend backend :url package) rev))) - ((and-let* ((desc (assoc name-or-url package-archive-contents #'string=))) + ((and-let* ((desc (assoc package package-archive-contents #'string=))) (package-vc--unpack (let ((copy (copy-package-desc (cadr desc)))) (setf (package-desc-kind copy) 'vc) @@ -626,9 +699,9 @@ uses `package-vc--guess-backend' to guess the backend." (url (alist-get :url extras)) (backend (package-vc--guess-backend url))) (list :vc-backend backend :url url)) - (user-error "Package has no VC data")) + (user-error "Package `%s' has no VC data" package)) rev))) - ((user-error "Unknown package to fetch: %s" name-or-url)))) + ((user-error "Unknown package to fetch: %s" package)))) ;;;###autoload (defun package-vc-checkout (pkg-desc directory &optional rev) @@ -642,25 +715,20 @@ package's repository. If REV has the special value `:last-release' (interactively, the prefix argument), that stands for the last released version of the package." (interactive - (progn - ;; Initialize the package system to get the list of package - ;; symbols for completion. - (package-vc--archives-initialize) - (let* ((packages (package-vc--sourced-packages-list)) - (input (completing-read - "Fetch package source (name or URL): " packages))) - (list (cadr (assoc input package-archive-contents #'string=)) - (read-file-name "Clone into new or empty directory: " nil nil t nil - (lambda (dir) (or (not (file-exists-p dir)) - (directory-empty-p dir)))) - (and current-prefix-arg :last-release))))) + (let* ((name (package-vc--read-package-name "Fetch package source: "))) + (list (cadr (assoc name package-archive-contents #'string=)) + (read-file-name "Clone into new or empty directory: " nil nil t nil + (lambda (dir) (or (not (file-exists-p dir)) + (directory-empty-p dir)))) + (and current-prefix-arg :last-release)))) (package-vc--archives-initialize) (let ((pkg-spec (or (package-vc--desc->spec pkg-desc) (and-let* ((extras (package-desc-extras pkg-desc)) (url (alist-get :url extras)) (backend (package-vc--guess-backend url))) (list :vc-backend backend :url url)) - (user-error "Package has no VC data")))) + (user-error "Package `%s' has no VC data" + (package-desc-name pkg-desc))))) (package-vc--clone pkg-desc pkg-spec directory rev) (find-file directory))) @@ -682,45 +750,42 @@ name from the base name of DIR." (package-vc--archives-initialize) (let* ((name (or name (file-name-base (directory-file-name dir)))) (pkg-dir (expand-file-name name package-user-dir))) - (make-symbolic-link dir pkg-dir) - (package-vc--unpack-1 (package-desc-create - :name (intern name) - :kind 'vc) - pkg-dir))) + (make-symbolic-link (expand-file-name dir) pkg-dir) + (package-vc--unpack-1 + (package-desc-create + :name (intern name) + :kind 'vc) + (file-name-as-directory pkg-dir)))) ;;;###autoload -(defun package-vc-refresh (pkg-desc) - "Refresh the installation for package given by PKG-DESC. -Interactively, prompt for the name of the package to refresh." - (interactive (package-vc--read-pkg "Refresh package: ")) +(defun package-vc-rebuild (pkg-desc) + "Rebuild the installation for package given by PKG-DESC. +Rebuilding an installation means scraping for new autoload +cookies, re-compiling Emacs Lisp files, building and installing +any documentation, downloading any missing dependencies. This +command does not fetch new revisions from a remote server. That +is the responsibility of `package-vc-update'. Interactively, +prompt for the name of the package to rebuild." + (interactive (list (package-vc--read-package-desc "Rebuild package: " t))) (package-vc--unpack-1 pkg-desc (package-desc-dir pkg-desc))) -(defun package-vc--read-pkg (prompt) - "Query for a source package description with PROMPT." - (cadr (assoc (completing-read - prompt - package-alist - (lambda (pkg) (package-vc-p (cadr pkg))) - t) - package-alist - #'string=))) - ;;;###autoload -(defun package-vc-prepare-patch (pkg subject revisions) +(defun package-vc-prepare-patch (pkg-desc subject revisions) "Send patch for REVISIONS to maintainer of the package PKG using SUBJECT. -SUBJECT and REVISIONS are passed on to `vc-prepare-patch', which see. -PKG must be a package description. -Interactively, prompt for PKG, SUBJECT, and REVISIONS. However, -if the current buffer has marked commit log entries, REVISIONS -are the tags of the marked entries, see `log-view-get-marked'." +The function uses `vc-prepare-patch', passing SUBJECT and +REVISIONS directly. PKG-DESC must be a package description. +Interactively, prompt for PKG-DESC, SUBJECT, and REVISIONS. When +invoked with a numerical prefix argument, use the last N +revisions. When invoked interactively in a Log View buffer with +marked revisions, use those." (interactive - (list (package-vc--read-pkg "Package to prepare a patch for: ") + (list (package-vc--read-package-desc "Package to prepare a patch for: " t) (and (not vc-prepare-patches-separately) (read-string "Subject: " "[PATCH] " nil nil t)) - (or (log-view-get-marked) - (vc-read-multiple-revisions "Revisions: ")))) - (vc-prepare-patch (package-maintainers pkg t) - subject revisions)) + (vc-prepare-patch-prompt-revisions))) + (let ((default-directory (package-desc-dir pkg-desc))) + (vc-prepare-patch (package-maintainers pkg-desc t) + subject revisions))) (provide 'package-vc) ;;; package-vc.el ends here diff --git a/lisp/emacs-lisp/package.el b/lisp/emacs-lisp/package.el index 639aefd7764..d21d03192b4 100644 --- a/lisp/emacs-lisp/package.el +++ b/lisp/emacs-lisp/package.el @@ -1091,10 +1091,15 @@ untar into a directory named DIR; otherwise, signal an error." (backup-inhibited t) (version-control 'never)) (loaddefs-generate - pkg-dir output-file - nil - "(add-to-list 'load-path (directory-file-name - (or (file-name-directory #$) (car load-path))))") + pkg-dir output-file nil + (prin1-to-string + '(add-to-list + 'load-path + ;; Add the directory that will contain the autoload file to + ;; the load path. We don't hard-code `pkg-dir', to avoid + ;; issues if the package directory is moved around. + (or (and load-file-name (file-name-directory load-file-name)) + (car load-path))))) (let ((buf (find-buffer-visiting output-file))) (when buf (kill-buffer buf))) auto-name)) @@ -1359,10 +1364,7 @@ is non-nil, don't propagate connection errors (does not apply to errors signaled by ERROR-FORM or by BODY). \(fn URL &key ASYNC FILE ERROR-FORM NOERROR &rest BODY)" - (declare (indent defun) - ;; FIXME: This should be something like - ;; `form def-body &rest form', but that doesn't work. - (debug (form &rest sexp))) + (declare (indent defun) (debug (sexp body))) (while (keywordp (car body)) (setq body (cdr (cdr body)))) `(package--with-response-buffer-1 ,url (lambda () ,@body) @@ -1786,7 +1788,7 @@ similar to an entry in `package-alist'. Save the cached copy to \"archives/NAME/FILE\" in `package-user-dir'." ;; The downloaded archive contents will be read as part of ;; `package--update-downloads-in-progress'. - (dolist (archive package-archives) + (when async (cl-pushnew (cons archive file) package--downloads-in-progress :test #'equal)) (package--with-response-buffer (cdr archive) :file file @@ -2420,7 +2422,7 @@ installed), maybe you need to \\[package-refresh-contents]") (declare-function comp-el-to-eln-filename "comp.c") (defvar package-vc-repository-store) -(defun package--delete-directory (dir pkg-desc) +(defun package--delete-directory (dir) "Delete PKG-DESC directory DIR recursively. Clean-up the corresponding .eln files if Emacs is native compiled." @@ -2428,17 +2430,8 @@ compiled." (cl-loop for file in (directory-files-recursively dir "\\.el\\'") do (comp-clean-up-stale-eln (comp-el-to-eln-filename file)))) - (if (and (package-vc-p pkg-desc) - (require 'package-vc) ;load `package-vc-repository-store' - (file-in-directory-p dir package-vc-repository-store)) - (progn - (delete-directory - (expand-file-name - (car (file-name-split - (file-relative-name dir package-vc-repository-store))) - package-vc-repository-store) - t) - (delete-file (directory-file-name dir))) + (if (file-symlink-p (directory-file-name dir)) + (delete-file (directory-file-name dir)) (delete-directory dir t))) @@ -2494,7 +2487,7 @@ If NOSAVE is non-nil, the package is not removed from (package-desc-name pkg-used-elsewhere-by))) (t (add-hook 'post-command-hook #'package-menu--post-refresh) - (package--delete-directory dir pkg-desc) + (package--delete-directory dir) ;; Remove NAME-VERSION.signed and NAME-readme.txt files. ;; ;; NAME-readme.txt files are no longer created, but they @@ -4540,19 +4533,28 @@ DESC must be a `package-desc' object." (funcall browse-url-secondary-browser-function url) (browse-url url)))) +(declare-function ietf-drums-parse-address "ietf-drums" + (string &optional decode)) + (defun package-maintainers (pkg-desc &optional no-error) "Return an email address for the maintainers of PKG-DESC. The email address may contain commas, if there are multiple maintainers. If no maintainers are found, an error will be -signalled. If the optional argument NO-ERROR is non-nil no error -will be signalled in that case." - (unless pkg-desc - (error "Invalid package description")) - (let* ((extras (package-desc-extras pkg-desc)) +signaled. If the optional argument NO-ERROR is non-nil no error +will be signaled in that case." + (unless (package-desc-p pkg-desc) + (error "Invalid package description: %S" pkg-desc)) + (let* ((name (package-desc-name pkg-desc)) + (extras (package-desc-extras pkg-desc)) (maint (alist-get :maintainer extras))) (cond ((and (null maint) (null no-error)) - (user-error "Package has no explicit maintainer")) + (user-error "Package `%s' has no explicit maintainer" name)) + ((and (not (progn + (require 'ietf-drums) + (ietf-drums-parse-address maint))) + (null no-error)) + (user-error "Package `%s' has no maintainer address" name)) ((not (null maint)) (with-temp-buffer (package--print-email-button maint) diff --git a/lisp/emacs-lisp/rmc.el b/lisp/emacs-lisp/rmc.el index dae6590b9bc..1083a6868ba 100644 --- a/lisp/emacs-lisp/rmc.el +++ b/lisp/emacs-lisp/rmc.el @@ -125,7 +125,7 @@ ;;;###autoload (defun read-multiple-choice (prompt choices &optional help-string show-help long-form) - "Ask user to select an entry from CHOICES, promting with PROMPT. + "Ask user to select an entry from CHOICES, prompting with PROMPT. This function allows to ask the user a multiple-choice question. CHOICES should be a list of the form (KEY NAME [DESCRIPTION]). diff --git a/lisp/emacs-lisp/seq.el b/lisp/emacs-lisp/seq.el index 82ade0ac0c3..1645da2eb0b 100644 --- a/lisp/emacs-lisp/seq.el +++ b/lisp/emacs-lisp/seq.el @@ -63,8 +63,7 @@ ;; preloaded. See also Bug#39761#26. (defmacro seq-doseq (spec &rest body) - "Loop over a sequence. -Evaluate BODY with VAR bound to each element of SEQUENCE, in turn. + "Loop over a SEQUENCE, evaluating BODY with VAR bound to each of its elements. Similar to `dolist' but can be applied to lists, strings, and vectors. @@ -95,7 +94,7 @@ name to be bound to the rest of SEQUENCE." ,@body)) (defmacro seq-setq (args sequence) - "Assign to the variables in ARGS the elements of SEQUENCE. + "Assign the elements of SEQUENCE to the variables in ARGS. ARGS can also include the `&rest' marker followed by a variable name to be bound to the rest of SEQUENCE." @@ -105,7 +104,7 @@ name to be bound to the rest of SEQUENCE." ;;; Basic seq functions that have to be implemented by new sequence types (cl-defgeneric seq-elt (sequence n) - "Return Nth element of SEQUENCE." + "Return the Nth element of SEQUENCE." (elt sequence n)) ;; Default gv setters for `seq-elt'. @@ -118,7 +117,7 @@ name to be bound to the rest of SEQUENCE." (setcar (nthcdr n sequence) store)) (cl-defgeneric seq-length (sequence) - "Return the number of elements of SEQUENCE." + "Return the number of elements in SEQUENCE." (length sequence)) (defun seq-first (sequence) @@ -126,11 +125,12 @@ name to be bound to the rest of SEQUENCE." (seq-elt sequence 0)) (defun seq-rest (sequence) - "Return a sequence of the elements of SEQUENCE except the first one." + "Return SEQUENCE with its first element removed." (seq-drop sequence 1)) (cl-defgeneric seq-do (function sequence) - "Apply FUNCTION to each element of SEQUENCE, presumably for side effects. + "Apply FUNCTION to each element of SEQUENCE. +Presumably, FUNCTION has useful side effects. Return SEQUENCE." (mapc function sequence)) @@ -216,8 +216,9 @@ the sequence, and its index within the sequence." (mapcar function sequence)) (cl-defgeneric seq-mapn (function sequence &rest sequences) - "Like `seq-map' but FUNCTION is mapped over all SEQUENCES. -The arity of FUNCTION must match the number of SEQUENCES, and the + "Return the result of applying FUNCTION to each element of SEQUENCEs. +Like `seq-map', but FUNCTION is mapped over all SEQUENCEs. +The arity of FUNCTION must match the number of SEQUENCEs, and the mapping stops on the shortest sequence. Return a list of the results. @@ -232,7 +233,7 @@ Return a list of the results. (nreverse result))) (cl-defgeneric seq-drop (sequence n) - "Remove the first N elements of SEQUENCE and return the result. + "Remove the first N elements of SEQUENCE and return the resulting sequence. The result is a sequence of the same type as SEQUENCE. If N is a negative integer or zero, SEQUENCE is returned." @@ -243,7 +244,7 @@ If N is a negative integer or zero, SEQUENCE is returned." ;;;###autoload (cl-defgeneric seq-take (sequence n) - "Take the first N elements of SEQUENCE and return the result. + "Return the sequence made of the first N elements of SEQUENCE. The result is a sequence of the same type as SEQUENCE. If N is a negative integer or zero, an empty sequence is @@ -252,14 +253,17 @@ returned." (cl-defgeneric seq-drop-while (pred sequence) "Remove the successive elements of SEQUENCE for which PRED returns non-nil. -PRED is a function of one argument. The result is a sequence of -the same type as SEQUENCE." +PRED is a function of one argument. The function keeps removing +elements from SEQUENCE until PRED returns nil for an element. +Value is a sequence of the same type as SEQUENCE." (seq-drop sequence (seq--count-successive pred sequence))) (cl-defgeneric seq-take-while (pred sequence) "Take the successive elements of SEQUENCE for which PRED returns non-nil. -PRED is a function of one argument. The result is a sequence of -the same type as SEQUENCE." +PRED is a function of one argument. The function keeps collecting +elements from SEQUENCE and adding them to the result until PRED +returns nil for an element. +Value is a sequence of the same type as SEQUENCE." (seq-take sequence (seq--count-successive pred sequence))) (cl-defgeneric seq-empty-p (sequence) @@ -267,7 +271,7 @@ the same type as SEQUENCE." (= 0 (seq-length sequence))) (cl-defgeneric seq-sort (pred sequence) - "Sort SEQUENCE using PRED as comparison function. + "Sort SEQUENCE using PRED as the sorting comparison function. The result is a sequence of the same type as SEQUENCE." (let ((result (seq-sort pred (append sequence nil)))) (seq-into result (type-of sequence)))) @@ -277,7 +281,7 @@ The result is a sequence of the same type as SEQUENCE." ;;;###autoload (defun seq-sort-by (function pred sequence) - "Sort SEQUENCE using PRED as a comparison function. + "Sort SEQUENCE transformed by FUNCTION using PRED as the comparison function. Elements of SEQUENCE are transformed by FUNCTION before being sorted. FUNCTION must be a function of one argument." (seq-sort (lambda (a b) @@ -300,7 +304,7 @@ sorted. FUNCTION must be a function of one argument." (cl-defgeneric seq-concatenate (type &rest sequences) "Concatenate SEQUENCES into a single sequence of type TYPE. -TYPE must be one of following symbols: vector, string or list. +TYPE must be one of following symbols: `vector', `string' or `list'. \n(fn TYPE SEQUENCE...)" (setq sequences (mapcar #'seq-into-sequence sequences)) @@ -322,8 +326,8 @@ of sequence." (cl-defgeneric seq-into (sequence type) "Concatenate the elements of SEQUENCE into a sequence of type TYPE. -TYPE can be one of the following symbols: vector, string or -list." +TYPE can be one of the following symbols: `vector', `string' or +`list'." (pcase type (`vector (seq--into-vector sequence)) (`string (seq--into-string sequence)) @@ -332,7 +336,7 @@ list." ;;;###autoload (cl-defgeneric seq-filter (pred sequence) - "Return a list of all elements for which (PRED element) is non-nil in SEQUENCE." + "Return a list of all the elements in SEQUENCE for which PRED returns non-nil." (let ((exclude (make-symbol "exclude"))) (delq exclude (seq-map (lambda (elt) (if (funcall pred elt) @@ -342,13 +346,13 @@ list." ;;;###autoload (cl-defgeneric seq-remove (pred sequence) - "Return a list of all the elements for which (PRED element) is nil in SEQUENCE." + "Return a list of all the elements in SEQUENCE for which PRED returns nil." (seq-filter (lambda (elt) (not (funcall pred elt))) sequence)) ;;;###autoload (cl-defgeneric seq-remove-at-position (sequence n) - "Return a copy of SEQUENCE where the element at N got removed. + "Return a copy of SEQUENCE with the element at index N removed. N is the (zero-based) index of the element that should not be in the result. @@ -381,7 +385,7 @@ If SEQUENCE is empty, return INITIAL-VALUE and FUNCTION is not called." ;;;###autoload (cl-defgeneric seq-every-p (pred sequence) - "Return non-nil if (PRED element) is non-nil for all elements of SEQUENCE." + "Return non-nil if PRED returns non-nil for all the elements of SEQUENCE." (catch 'seq--break (seq-doseq (elt sequence) (or (funcall pred elt) @@ -390,8 +394,8 @@ If SEQUENCE is empty, return INITIAL-VALUE and FUNCTION is not called." ;;;###autoload (cl-defgeneric seq-some (pred sequence) - "Return non-nil if PRED is satisfied for at least one element of SEQUENCE. -If so, return the first non-nil value returned by PRED." + "Return non-nil if PRED returns non-nil for at least one element of SEQUENCE. +If the value is non-nil, it is the first non-nil value returned by PRED." (catch 'seq--break (seq-doseq (elt sequence) (let ((result (funcall pred elt))) @@ -401,12 +405,12 @@ If so, return the first non-nil value returned by PRED." ;;;###autoload (cl-defgeneric seq-find (pred sequence &optional default) - "Return the first element for which (PRED element) is non-nil in SEQUENCE. -If no element is found, return DEFAULT. + "Return the first element in SEQUENCE for which PRED returns non-nil. +If no such element is found, return DEFAULT. Note that `seq-find' has an ambiguity if the found element is -identical to DEFAULT, as it cannot be known if an element was -found or not." +identical to DEFAULT, as in that case it is impossible to know +whether an element was found or not." (catch 'seq--break (seq-doseq (elt sequence) (when (funcall pred elt) @@ -414,7 +418,7 @@ found or not." default)) (cl-defgeneric seq-count (pred sequence) - "Return the number of elements for which (PRED element) is non-nil in SEQUENCE." + "Return the number of elements in SEQUENCE for which PRED returns non-nil." (let ((count 0)) (seq-doseq (elt sequence) (when (funcall pred elt) @@ -422,8 +426,8 @@ found or not." count)) (cl-defgeneric seq-contains (sequence elt &optional testfn) - "Return the first element in SEQUENCE that is equal to ELT. -Equality is defined by the function TESTFN, which defaults to `equal'." + "Return the first element in SEQUENCE that is \"equal\" to ELT. +\"Equality\" is defined by the function TESTFN, which defaults to `equal'." (declare (obsolete seq-contains-p "27.1")) (seq-some (lambda (e) (when (funcall (or testfn #'equal) elt e) @@ -431,8 +435,8 @@ Equality is defined by the function TESTFN, which defaults to `equal'." sequence)) (cl-defgeneric seq-contains-p (sequence elt &optional testfn) - "Return non-nil if SEQUENCE contains an element equal to ELT. -Equality is defined by the function TESTFN, which defaults to `equal'." + "Return non-nil if SEQUENCE contains an element \"equal\" to ELT. +\"Equality\" is defined by the function TESTFN, which defaults to `equal'." (catch 'seq--break (seq-doseq (e sequence) (let ((r (funcall (or testfn #'equal) e elt))) @@ -442,15 +446,16 @@ Equality is defined by the function TESTFN, which defaults to `equal'." (cl-defgeneric seq-set-equal-p (sequence1 sequence2 &optional testfn) "Return non-nil if SEQUENCE1 and SEQUENCE2 contain the same elements. -This does not depend on the order of the elements. -Equality is defined by the function TESTFN, which defaults to `equal'." +The order of the elements in the sequences is not important. +\"Equality\" of elements is defined by the function TESTFN, which +defaults to `equal'." (and (seq-every-p (lambda (item1) (seq-contains-p sequence2 item1 testfn)) sequence1) (seq-every-p (lambda (item2) (seq-contains-p sequence1 item2 testfn)) sequence2))) ;;;###autoload (cl-defgeneric seq-position (sequence elt &optional testfn) - "Return the (zero-based) index of the first element in SEQUENCE equal to ELT. -Equality is defined by the function TESTFN, which defaults to `equal'." + "Return the (zero-based) index of the first element in SEQUENCE \"equal\" to ELT. +\"Equality\" is defined by the function TESTFN, which defaults to `equal'." (let ((index 0)) (catch 'seq--break (seq-doseq (e sequence) @@ -461,11 +466,11 @@ Equality is defined by the function TESTFN, which defaults to `equal'." ;;;###autoload (cl-defgeneric seq-positions (sequence elt &optional testfn) - "Return indices for which (TESTFN (seq-elt SEQUENCE index) ELT) is non-nil. + "Return list of indices of SEQUENCE elements for which TESTFN returns non-nil. -TESTFN is a two-argument function which is passed each element of -SEQUENCE as first argument and ELT as second. TESTFN defaults to -`equal'. +TESTFN is a two-argument function which is called with each element of +SEQUENCE as the first argument and ELT as the second. +TESTFN defaults to `equal'. The result is a list of (zero-based) indices." (let ((result '())) @@ -479,7 +484,7 @@ The result is a list of (zero-based) indices." ;;;###autoload (cl-defgeneric seq-uniq (sequence &optional testfn) "Return a list of the elements of SEQUENCE with duplicates removed. -TESTFN is used to compare elements, or `equal' if TESTFN is nil." +TESTFN is used to compare elements, and defaults to `equal'." (let ((result '())) (seq-doseq (elt sequence) (unless (seq-contains-p result elt testfn) @@ -514,15 +519,15 @@ TESTFN is used to compare elements, or `equal' if TESTFN is nil." (nreverse result))) (cl-defgeneric seq-mapcat (function sequence &optional type) - "Concatenate the result of applying FUNCTION to each element of SEQUENCE. -The result is a sequence of type TYPE, or a list if TYPE is nil." + "Concatenate the results of applying FUNCTION to each element of SEQUENCE. +The result is a sequence of type TYPE; TYPE defaults to `list'." (apply #'seq-concatenate (or type 'list) (seq-map function sequence))) (cl-defgeneric seq-partition (sequence n) "Return list of elements of SEQUENCE grouped into sub-sequences of length N. The last sequence may contain less than N elements. If N is a -negative integer or 0, nil is returned." +negative integer or 0, the function returns nil." (unless (< n 1) (let ((result '())) (while (not (seq-empty-p sequence)) @@ -532,8 +537,9 @@ negative integer or 0, nil is returned." ;;;###autoload (cl-defgeneric seq-union (sequence1 sequence2 &optional testfn) - "Return a list of all elements that appear in either SEQUENCE1 or SEQUENCE2. -Equality is defined by the function TESTFN, which defaults to `equal'." + "Return a list of all the elements that appear in either SEQUENCE1 or SEQUENCE2. +\"Equality\" of elements is defined by the function TESTFN, which +defaults to `equal'." (let* ((accum (lambda (acc elt) (if (seq-contains-p acc elt testfn) acc @@ -544,8 +550,9 @@ Equality is defined by the function TESTFN, which defaults to `equal'." ;;;###autoload (cl-defgeneric seq-intersection (sequence1 sequence2 &optional testfn) - "Return a list of the elements that appear in both SEQUENCE1 and SEQUENCE2. -Equality is defined by the function TESTFN, which defaults to `equal'." + "Return a list of all the elements that appear in both SEQUENCE1 and SEQUENCE2. +\"Equality\" of elements is defined by the function TESTFN, which +defaults to `equal'." (seq-reduce (lambda (acc elt) (if (seq-contains-p sequence2 elt testfn) (cons elt acc) @@ -554,8 +561,9 @@ Equality is defined by the function TESTFN, which defaults to `equal'." '())) (cl-defgeneric seq-difference (sequence1 sequence2 &optional testfn) - "Return a list of the elements that appear in SEQUENCE1 but not in SEQUENCE2. -Equality is defined by the function TESTFN, which defaults to `equal'." + "Return list of all the elements that appear in SEQUENCE1 but not in SEQUENCE2. +\"Equality\" of elements is defined by the function TESTFN, which +defaults to `equal'." (seq-reduce (lambda (acc elt) (if (seq-contains-p sequence2 elt testfn) acc @@ -591,7 +599,7 @@ SEQUENCE must be a sequence of numbers or markers." (apply #'max (seq-into sequence 'list))) (defun seq--count-successive (pred sequence) - "Count successive elements for which (PRED element) is non-nil in SEQUENCE." + "Count successive elements in SEQUENCE for which PRED returns non-nil." (let ((n 0) (len (seq-length sequence))) (while (and (< n len) @@ -628,13 +636,13 @@ SEQUENCE must be a sequence of numbers or markers." ;; TODO: make public? (defun seq--elt-safe (sequence n) - "Return element of SEQUENCE at the index N. + "Return the element of SEQUENCE whose zero-based index is N. If no element is found, return nil." (ignore-errors (seq-elt sequence n))) ;;;###autoload (cl-defgeneric seq-random-elt (sequence) - "Return a random element from SEQUENCE. + "Return a randomly chosen element from SEQUENCE. Signal an error if SEQUENCE is empty." (if (seq-empty-p sequence) (error "Sequence cannot be empty") @@ -681,8 +689,8 @@ Signal an error if SEQUENCE is empty." (concat sequence))) (defun seq-split (sequence length) - "Split SEQUENCE into a list of sub-sequences of at most LENGTH. -All the sub-sequences will be of LENGTH, except the last one, + "Split SEQUENCE into a list of sub-sequences of at most LENGTH elements. +All the sub-sequences will be LENGTH long, except the last one, which may be shorter." (when (< length 1) (error "Sub-sequence length must be larger than zero")) @@ -696,7 +704,7 @@ which may be shorter." (nreverse result))) (defun seq-keep (function sequence) - "Apply FUNCTION to SEQUENCE and return all non-nil results." + "Apply FUNCTION to SEQUENCE and return the list of all the non-nil results." (delq nil (seq-map function sequence))) (provide 'seq) diff --git a/lisp/emacs-lisp/shortdoc.el b/lisp/emacs-lisp/shortdoc.el index dbac03432c1..83283247150 100644 --- a/lisp/emacs-lisp/shortdoc.el +++ b/lisp/emacs-lisp/shortdoc.el @@ -833,7 +833,7 @@ A FUNC form can have any number of `:no-eval' (or `:no-value'), (seq-set-equal-p :eval (seq-set-equal-p '(1 2 3) '(3 1 2))) (seq-some - :eval (seq-some #'cl-evenp '(1 2 3))) + :eval (seq-some #'floatp '(1 2.0 3))) "Building Sequences" (seq-concatenate :eval (seq-concatenate 'vector '(1 2) '(c d))) @@ -898,14 +898,14 @@ A FUNC form can have any number of `:no-eval' (or `:no-value'), (seq-filter :eval (seq-filter #'numberp '(a b 3 4 f 6))) (seq-keep - :eval (seq-keep #'cl-digit-char-p '(?6 ?a ?7))) + :eval (seq-keep #'car-safe '((1 2) 3 t (a . b)))) (seq-remove :eval (seq-remove #'numberp '(1 2 c d 5))) (seq-remove-at-position :eval (seq-remove-at-position '(a b c d e) 3) :eval (seq-remove-at-position [a b c d e] 0)) (seq-group-by - :eval (seq-group-by #'cl-plusp '(-1 2 3 -4 -5 6))) + :eval (seq-group-by #'natnump '(-1 2 3 -4 -5 6))) (seq-union :eval (seq-union '(1 2 3) '(3 5))) (seq-difference @@ -921,7 +921,7 @@ A FUNC form can have any number of `:no-eval' (or `:no-value'), (seq-split :eval (seq-split [0 1 2 3 5] 2)) (seq-take-while - :eval (seq-take-while #'cl-evenp [2 4 9 6 5])) + :eval (seq-take-while #'integerp [1 2 3.0 4])) (seq-uniq :eval (seq-uniq '(a b d b a c)))) @@ -1374,13 +1374,20 @@ If SAME-WINDOW, don't pop to a new window." (unless (bobp) (insert "\n")) (insert (propertize - (concat (substitute-command-keys data) "\n\n") + (substitute-command-keys data) + 'face 'shortdoc-heading + 'shortdoc-section t + 'outline-level 1)) + (insert (propertize + "\n\n" 'face 'shortdoc-heading 'shortdoc-section t))) ;; There may be functions not yet defined in the data. ((fboundp (car data)) (when prev - (insert (make-separator-line))) + (insert (make-separator-line) + ;; This helps with hidden outlines (bug#53981) + (propertize "\n" 'face '(:height 0)))) (setq prev t) (shortdoc--display-function data)))) (cdr (assq group shortdoc--groups)))) @@ -1397,7 +1404,7 @@ If SAME-WINDOW, don't pop to a new window." (start-section (point)) arglist-start) ;; Function calling convention. - (insert (propertize "(" 'shortdoc-function function)) + (insert (propertize "(" 'shortdoc-function function 'outline-level 2)) (if (plist-get data :no-manual) (insert-text-button (symbol-name function) @@ -1531,7 +1538,10 @@ Example: (define-derived-mode shortdoc-mode special-mode "shortdoc" "Mode for shortdoc." - :interactive nil) + :interactive nil + (setq-local outline-search-function #'outline-search-level + outline-level (lambda () + (get-text-property (point) 'outline-level)))) (defun shortdoc--goto-section (arg sym &optional reverse) (unless (natnump arg) diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el index 61d52026b38..b86070deeff 100644 --- a/lisp/emacs-lisp/smie.el +++ b/lisp/emacs-lisp/smie.el @@ -56,7 +56,7 @@ ;; which includes a kind of tutorial to get started with SMIE: ;; ;; SMIE: Weakness is Power! Auto-indentation with incomplete information -;; Stefan Monnier, <Programming> Journal 2020, volumn 5, issue 1. +;; Stefan Monnier, <Programming> Journal 2020, volume 5, issue 1. ;; doi: 10.22152/programming-journal.org/2021/5/1 ;; A good background to understand the development (especially the parts diff --git a/lisp/emacs-lisp/subr-x.el b/lisp/emacs-lisp/subr-x.el index 6e4d88b4df3..18087bc937f 100644 --- a/lisp/emacs-lisp/subr-x.el +++ b/lisp/emacs-lisp/subr-x.el @@ -322,6 +322,10 @@ as the new values of the bound variables in the recursive invocation." ;; Keeping a work buffer around is more efficient than creating a ;; new temporary buffer. (with-current-buffer (get-buffer-create " *string-pixel-width*") + ;; `display-line-numbers-mode' is enabled in internal buffers + ;; that breaks width calculation, so need to disable (bug#59311) + (when (bound-and-true-p display-line-numbers-mode) + (display-line-numbers-mode -1)) (delete-region (point-min) (point-max)) (insert string) (car (buffer-text-pixel-size nil nil t))))) diff --git a/lisp/emacs-lisp/tcover-ses.el b/lisp/emacs-lisp/tcover-ses.el index 2b1672ffd64..645b1a328f0 100644 --- a/lisp/emacs-lisp/tcover-ses.el +++ b/lisp/emacs-lisp/tcover-ses.el @@ -569,7 +569,7 @@ spreadsheet files with invalid formatting." (signal 'singularity-error nil)) ;Shouldn't get here (singularity-error (error "No error from %s?" x)) (error nil))) - ;;Test quit-handling in ses-update-cells. Cant' use `eval' here. + ;; Test quit-handling in ses-update-cells. Can't use `eval' here. (let ((inhibit-quit t)) (setq quit-flag t) (condition-case nil diff --git a/lisp/erc/ChangeLog.1 b/lisp/erc/ChangeLog.1 index 8fc97854303..64231f365e2 100644 --- a/lisp/erc/ChangeLog.1 +++ b/lisp/erc/ChangeLog.1 @@ -9372,8 +9372,8 @@ 2002-08-14 Mario Lang <mlang@delysid.org> - * erc-button.el: - Try to be compatible to XEmacs regexp-opt. (Im going to quit this job if I find more of those damn differencies + * erc-button.el: Try to be compatible to XEmacs regexp-opt. (I'm + going to quit this job if I find more of those damn differences.) * debian/README.Debian, debian/scripts/install: * Added info to README.Debian @@ -11075,7 +11075,8 @@ stay at your current version. It seems fairly stable though. That changed? erc-buffer-name handling was completely rewritten, and erc-buffer-list local variable handling removed. - Simplifies alot of code. Poke at it. read the diff. report bug/send patches! + Simplifies a lot of code. Poke at it. Read the diff. Report + bug/send patches! * erc.el: * Added variable listing when /set is used without args @@ -11448,7 +11449,7 @@ 2001-10-03 Mario Lang <mlang@delysid.org> * erc.el: - * Removed alot of (progn ...) where they were not necessary + * Removed a lot of (progn ...) where they were not necessary * Changed some (if ...) without else part to (when ...) * Some (while ...) to use (dolist ...) * Fix for completion popup generating tracebacks. diff --git a/lisp/erc/erc-backend.el b/lisp/erc/erc-backend.el index 026b34849a0..15fd6ac50f5 100644 --- a/lisp/erc/erc-backend.el +++ b/lisp/erc/erc-backend.el @@ -299,6 +299,9 @@ function `erc-server-process-alive' instead.") (defvar-local erc--server-last-reconnect-count 0 "Snapshot of reconnect count when the connection was established.") +(defvar-local erc--server-reconnect-timer nil + "Auto-reconnect timer for a network context.") + (defvar-local erc-server-quitting nil "Non-nil if the user requests a quit.") @@ -401,6 +404,16 @@ This only has an effect if `erc-server-auto-reconnect' is non-nil." If a key is pressed while ERC is waiting, it will stop waiting." :type 'number) +(defcustom erc-server-reconnect-function 'erc-server-delayed-reconnect + "Function called by the reconnect timer to create a new connection. +Called with a server buffer as its only argument. Potential uses +include exponential backoff and probing for connectivity prior to +dialing. Use `erc-schedule-reconnect' to instead try again later +and optionally alter the attempts tally." + :package-version '(ERC . "5.4.1") ; FIXME on next release + :type '(choice (function-item erc-server-delayed-reconnect) + function)) + (defcustom erc-split-line-length 440 "The maximum length of a single message. If a message exceeds this size, it is broken into multiple ones. @@ -625,12 +638,18 @@ The current buffer is given by BUFFER." (let ((p (plist-put parameters :nowait t))) (apply #'open-network-stream name buffer host service p))) +(defvar erc--server-connect-dumb-ipv6-regexp + ;; Not for validation (gives false positives). + (rx bot "[" (group (+ (any xdigit digit ":.")) (? "%" (+ alnum))) "]" eot)) + (defun erc-server-connect (server port buffer &optional client-certificate) "Perform the connection and login using the specified SERVER and PORT. We will store server variables in the buffer given by BUFFER. CLIENT-CERTIFICATE may optionally be used to specify a TLS client certificate to use for authentication when connecting over TLS (see `erc-session-client-certificate' for more details)." + (when (string-match erc--server-connect-dumb-ipv6-regexp server) + (setq server (match-string 1 server))) (let ((msg (erc-format-message 'connect ?S server ?p port)) process (args `(,(format "erc-%s-%s" server port) nil ,server ,port))) (when client-certificate @@ -645,7 +664,8 @@ TLS (see `erc-session-client-certificate' for more details)." (setq erc-server-process process) (setq erc-server-quitting nil) (setq erc-server-reconnecting nil - erc--server-reconnecting nil) + erc--server-reconnecting nil + erc--server-reconnect-timer nil) (setq erc-server-timed-out nil) (setq erc-server-banned nil) (setq erc-server-error-occurred nil) @@ -686,6 +706,7 @@ Make sure you are in an ERC buffer when running this." (with-current-buffer buffer (erc-update-mode-line) (erc-set-active-buffer (current-buffer)) + (setq erc--server-reconnecting t) (setq erc-server-last-sent-time 0) (setq erc-server-lines-sent 0) (let ((erc-server-connect-function (or erc-session-connector @@ -758,37 +779,59 @@ EVENT is the message received from the closed connection process." erc-server-reconnecting) (erc--server-reconnect-p event))) +(defconst erc--mode-line-process-reconnecting + '(:eval (erc-with-server-buffer + (and erc--server-reconnect-timer + (format ": reconnecting in %.1fs" + (- (timer-until erc--server-reconnect-timer + (current-time))))))) + "Mode-line construct showing seconds until next reconnect attempt. +Move point around to refresh.") + +(defun erc--cancel-auto-reconnect-timer () + (when erc--server-reconnect-timer + (cancel-timer erc--server-reconnect-timer) + (erc-display-message nil 'notice nil 'reconnect-canceled + ?u (buffer-name) + ?c (- (timer-until erc--server-reconnect-timer + (current-time)))) + (setq erc--server-reconnect-timer nil) + (erc-update-mode-line))) + +(defun erc-schedule-reconnect (buffer &optional incr) + "Create and return a reconnect timer for BUFFER. +When `erc-server-reconnect-attempts' is a number, increment +`erc-server-reconnect-count' by INCR unconditionally." + (let ((count (and (integerp erc-server-reconnect-attempts) + (- erc-server-reconnect-attempts + (cl-incf erc-server-reconnect-count (or incr 1)))))) + (erc-display-message nil 'error (current-buffer) 'reconnecting + ?m erc-server-reconnect-timeout + ?i (if count erc-server-reconnect-count "N") + ?n (if count erc-server-reconnect-attempts "A")) + (setq erc-server-reconnecting nil + erc--server-reconnect-timer + (run-at-time erc-server-reconnect-timeout nil + erc-server-reconnect-function buffer)))) + (defun erc-process-sentinel-2 (event buffer) "Called when `erc-process-sentinel-1' has detected an unexpected disconnect." - (if (not (buffer-live-p buffer)) - (erc-update-mode-line) + (when (buffer-live-p buffer) (with-current-buffer buffer - (let ((reconnect-p (erc--server-reconnect-p event)) message delay) + (let ((reconnect-p (erc--server-reconnect-p event)) message) (setq message (if reconnect-p 'disconnected 'disconnected-noreconnect)) (erc-display-message nil 'error (current-buffer) message) (if (not reconnect-p) ;; terminate, do not reconnect (progn - (setq erc--server-reconnecting nil) + (setq erc--server-reconnecting nil + erc--server-reconnect-timer nil) (erc-display-message nil 'error (current-buffer) 'terminated ?e event) - ;; Update mode line indicators - (erc-update-mode-line) (set-buffer-modified-p nil)) ;; reconnect - (condition-case nil - (progn - (setq erc-server-reconnecting nil - erc--server-reconnecting t - erc-server-reconnect-count (1+ erc-server-reconnect-count)) - (setq delay erc-server-reconnect-timeout) - (run-at-time delay nil - #'erc-server-delayed-reconnect buffer)) - (error (unless (integerp erc-server-reconnect-attempts) - (message "%s ... %s" - "Reconnecting until we succeed" - "kill the ERC server buffer to stop")) - (erc-server-delayed-reconnect buffer)))))))) + (erc-schedule-reconnect buffer)))) + (erc-update-mode-line))) (defun erc-process-sentinel-1 (event buffer) "Called when `erc-process-sentinel' has decided that we're disconnecting. @@ -1085,8 +1128,37 @@ See also `erc-server-send'." ;;;; Handling responses +(defcustom erc-tags-format 'overridable + "Shape of the `tags' alist in `erc-response' objects. +When set to `legacy', pre-5.5 parsing behavior takes effect for +the tags portion of every message. The resulting alist contains +conses of the form (STRING . LIST), in which LIST is comprised of +at most one, possibly empty string. When set to nil, ERC only +parses tags if an active module defines an implementation. It +otherwise ignores them. In such cases, each alist element is a +cons of a symbol and an optional, nonempty string. + +With the default value of `overridable', ERC behaves as it does +with `legacy' except that it emits a warning whenever first +encountering a message containing tags in a given Emacs session. +But it only does so when a module implementing overriding, +non-legacy behavior isn't already active in the current network +context. + +Note that future bundled modules providing IRCv3 functionality +will not be compatible with the legacy format. User code should +eventually transition to expecting this \"5.5+ variant\" and set +this option to nil." + :package-version '(ERC . "5.4.1") ; FIXME increment on next release + :type '(choice (const nil) + (const legacy) + (const overridable))) + (defun erc-parse-tags (string) "Parse IRCv3 tags list in STRING to a (tag . value) alist." + (erc--parse-message-tags string)) + +(defun erc--parse-tags (string) (let ((tags) (tag-strings (split-string string ";"))) (dolist (tag-string tag-strings tags) @@ -1096,6 +1168,28 @@ See also `erc-server-send'." `(,pair)) tags))))) +;; A benefit of this function being internal is not having to define a +;; separate method just to ensure an `erc-tags-format' value of +;; `legacy' always wins. A downside is that module code must take +;; care to preserve that promise manually. + +(cl-defgeneric erc--parse-message-tags (string) + "Parse STRING into an alist of (TAG . VALUE) conses. +Expect TAG to be a symbol and VALUE nil or a nonempty string. +Don't split composite raw-input values containing commas; +instead, leave them as a single string." + (when erc-tags-format + (unless (or (eq erc-tags-format 'legacy) + (get 'erc-parse-tags 'erc-v3-warned-p)) + (put 'erc-parse-tags 'erc-v3-warned-p t) + (display-warning + 'ERC + (concat + "Legacy ERC tags behavior is currently in effect, but other modules," + " including those bundled with ERC, may override this in future" + " releases. See `erc-tags-format' for more info."))) + (erc--parse-tags string))) + (defun erc-parse-server-response (proc string) "Parse and act upon a complete line from an IRC server. PROC is the process (connection) from which STRING was received. @@ -1105,9 +1199,9 @@ PROCs `process-buffer' is `current-buffer' when this function is called." (let* ((tag-list (when (eq (aref string 0) ?@) (substring string 1 (string-search " " string)))) - (msg (make-erc-response :unparsed string :tags (when tag-list - (erc-parse-tags - tag-list)))) + (msg (make-erc-response :unparsed string :tags + (when tag-list + (erc--parse-message-tags tag-list)))) (string (if tag-list (substring string (+ 1 (string-search " " string))) string)) diff --git a/lisp/erc/erc-common.el b/lisp/erc/erc-common.el index d8aac36eab6..23a19337986 100644 --- a/lisp/erc/erc-common.el +++ b/lisp/erc/erc-common.el @@ -77,6 +77,9 @@ (cl-defstruct (erc--target-channel (:include erc--target))) (cl-defstruct (erc--target-channel-local (:include erc--target-channel))) +;; Beginning in 5.5/29.1, the `tags' field may take on one of two +;; differing types. See `erc-tags-format' for details. + (cl-defstruct (erc-response (:conc-name erc-response.)) (unparsed "" :type string) (sender "" :type string) diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el index 03bd8f13527..d23703394be 100644 --- a/lisp/erc/erc-compat.el +++ b/lisp/erc/erc-compat.el @@ -32,6 +32,7 @@ ;;; Code: (require 'compat nil 'noerror) +(eval-when-compile (require 'cl-lib) (require 'url-parse)) ;;;###autoload(autoload 'erc-define-minor-mode "erc-compat") (define-obsolete-function-alias 'erc-define-minor-mode @@ -157,6 +158,121 @@ If START or END is negative, it counts from the end." res)))))) +;;;; Auth Source + +(declare-function auth-source-pass--get-attr + "auth-source-pass" (key entry-data)) +(declare-function auth-source-pass--disambiguate + "auth-source-pass" (host &optional user port)) +(declare-function auth-source-backend-parse-parameters + "auth-source-pass" (entry backend)) +(declare-function auth-source-backend "auth-source" (&rest slots)) +(declare-function auth-source-pass-entries "auth-source-pass" nil) +(declare-function auth-source-pass-parse-entry "auth-source-pass" (entry)) + +(defvar auth-sources) +(defvar auth-source-backend-parser-functions) + +;; This hard codes `auth-source-pass-port-separator' to ":" +(defun erc-compat--29-auth-source-pass--retrieve-parsed (seen e port-number-p) + (when (string-match (rx (or bot "/") + (or (: (? (group-n 20 (+ (not (in " /@")))) "@") + (group-n 10 (+ (not (in " /:@")))) + (? ":" (group-n 30 (+ (not (in " /:")))))) + (: (group-n 11 (+ (not (in " /:@")))) + (? ":" (group-n 31 (+ (not (in " /:"))))) + (? "/" (group-n 21 (+ (not (in " /:"))))))) + eot) + e) + (puthash e `( :host ,(or (match-string 10 e) (match-string 11 e)) + ,@(if-let* ((tr (match-string 21 e))) + (list :user tr :suffix t) + (list :user (match-string 20 e))) + :port ,(and-let* ((p (or (match-string 30 e) + (match-string 31 e))) + (n (string-to-number p))) + (if (or (zerop n) (not port-number-p)) + (format "%s" p) + n))) + seen))) + +;; This looks bad, but it just inlines `auth-source-pass--find-match-many'. +(defun erc-compat--29-auth-source-pass--build-result-many + (hosts users ports require max) + "Return a plist of HOSTS, PORTS, USERS, and secret." + (unless (listp hosts) (setq hosts (list hosts))) + (unless (listp users) (setq users (list users))) + (unless (listp ports) (setq ports (list ports))) + (unless max (setq max 1)) + (let ((seen (make-hash-table :test #'equal)) + (entries (auth-source-pass-entries)) + (check (lambda (m k v) + (let ((mv (plist-get m k))) + (if (memq k require) + (and v (equal mv v)) + (or (not v) (not mv) (equal mv v)))))) + out suffixed suffixedp) + (catch 'done + (dolist (host hosts) + (pcase-let ((`(,_ ,u ,p) (auth-source-pass--disambiguate host))) + (unless (or (not (equal "443" p)) (string-prefix-p "https://" host)) + (setq p nil)) + (dolist (user (or users (list u))) + (dolist (port (or ports (list p))) + (dolist (e entries) + (when-let* + ((m (or (gethash e seen) + (erc-compat--29-auth-source-pass--retrieve-parsed + seen e (integerp port)))) + ((equal host (plist-get m :host))) + ((funcall check m :port port)) + ((funcall check m :user user)) + (parsed (auth-source-pass-parse-entry e)) + (secret (or (auth-source-pass--get-attr 'secret parsed) + (not (memq :secret require))))) + (push + `( :host ,host ; prefer user-provided :host over h + ,@(and-let* ((u (plist-get m :user))) (list :user u)) + ,@(and-let* ((p (plist-get m :port))) (list :port p)) + ,@(and secret (not (eq secret t)) (list :secret secret))) + (if (setq suffixedp (plist-get m :suffix)) suffixed out)) + (unless suffixedp + (when (or (zerop (cl-decf max)) + (null (setq entries (delete e entries)))) + (throw 'done out))))) + (setq suffixed (nreverse suffixed)) + (while suffixed + (push (pop suffixed) out) + (when (zerop (cl-decf max)) + (throw 'done out)))))))) + (reverse out))) + +(cl-defun erc-compat--29-auth-source-pass-search + (&rest spec &key host user port require max &allow-other-keys) + ;; From `auth-source-pass-search' + (cl-assert (and host (not (eq host t))) + t "Invalid password-store search: %s %s") + (erc-compat--29-auth-source-pass--build-result-many + host user port require max)) + +(defun erc-compat--29-auth-source-pass-backend-parse (entry) + (when (eq entry 'password-store) + (auth-source-backend-parse-parameters + entry (auth-source-backend + :source "." + :type 'password-store + :search-function #'erc-compat--29-auth-source-pass-search)))) + +(defun erc-compat--auth-source-backend-parser-functions () + (if (memq 'password-store auth-sources) + (progn + (require 'auth-source-pass) + `(,@(unless (bound-and-true-p auth-source-pass-extra-query-keywords) + '(erc-compat--29-auth-source-pass-backend-parse)) + ,@auth-source-backend-parser-functions)) + auth-source-backend-parser-functions)) + + ;;;; Misc 29.1 (defmacro erc-compat--with-memoization (table &rest forms) @@ -168,6 +284,35 @@ If START or END is negative, it counts from the end." `(cl--generic-with-memoization ,table ,@forms)) (t `(progn ,@forms)))) +(defvar url-irc-function) + +(defun erc-compat--29-browse-url-irc (string &rest _) + (require 'url-irc) + (let* ((url (url-generic-parse-url string)) + (url-irc-function + (if (function-equal url-irc-function 'url-irc-erc) + (lambda (host port chan user pass) + (erc-handle-irc-url host port chan user pass (url-type url))) + url-irc-function))) + (url-irc url))) + +(cond ((fboundp 'browse-url-irc)) ; 29 + ((boundp 'browse-url-default-handlers) ; 28 + (cl-pushnew '("\\`irc6?s?://" . erc-compat--29-browse-url-irc) + browse-url-default-handlers)) + ((boundp 'browse-url-browser-function) ; 27 + (require 'browse-url) + (let ((existing browse-url-browser-function)) + (setq browse-url-browser-function + (if (functionp existing) + (lambda (u &rest r) + (apply (if (string-match-p "\\`irc6?s?://" u) + #'erc-compat--29-browse-url-irc + existing) + u r)) + (cons '("\\`irc6?s?://" . erc-compat--29-browse-url-irc) + existing)))))) + (provide 'erc-compat) ;;; erc-compat.el ends here diff --git a/lisp/erc/erc-networks.el b/lisp/erc/erc-networks.el index dba6ead073b..b3e5fcf1a30 100644 --- a/lisp/erc/erc-networks.el +++ b/lisp/erc/erc-networks.el @@ -1256,14 +1256,15 @@ server name and search for a match in `erc-networks-alist'." (defconst erc-networks--name-missing-sentinel (gensym "Unknown ") "Value to cover rare case of a literal NETWORK=nil.") -(defun erc-networks--determine () +(defun erc-networks--determine (&optional server) "Return the name of the network as a symbol. -Search `erc-networks-alist' for a known entity matching +Search `erc-networks-alist' for a known entity matching SERVER or `erc-server-announced-name'. If that fails, use the display name given by the `RPL_ISUPPORT' NETWORK parameter." (or (cl-loop for (name matcher) in erc-networks-alist - when (and matcher (string-match (concat matcher "\\'") - erc-server-announced-name)) + when (and matcher + (string-match (concat matcher "\\'") + (or server erc-server-announced-name))) return name) (and-let* ((vanity (erc--get-isupport-entry 'NETWORK 'single)) ((intern vanity)))) diff --git a/lisp/erc/erc-pcomplete.el b/lisp/erc/erc-pcomplete.el index af8528dbc38..3ba18e835bd 100644 --- a/lisp/erc/erc-pcomplete.el +++ b/lisp/erc/erc-pcomplete.el @@ -179,6 +179,10 @@ for use on `completion-at-point-function'." (defun pcomplete/erc-mode/UNIGNORE () (pcomplete-here (erc-with-server-buffer erc-ignore-list))) +(defun pcomplete/erc-mode/RECONNECT () + (pcomplete-here '("cancel")) + (pcomplete-opt "a")) + ;;; Functions that provide possible completions. (defun pcomplete-erc-commands () diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el index 6b14cf87e24..2312246e3ee 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -70,7 +70,7 @@ (require 'auth-source) (require 'time-date) (require 'iso8601) -(eval-when-compile (require 'subr-x)) +(eval-when-compile (require 'subr-x) (require 'url-parse)) (defconst erc-version "5.4.1" "This version of ERC.") @@ -1542,6 +1542,11 @@ symbol, it may have these values: * ircs -> 994 * ircd -> 6667 * ircd-dalnet -> 7000" + ;; These were updated somewhat in 2022 to reflect modern standards + ;; and practices. See also: + ;; + ;; https://datatracker.ietf.org/doc/html/rfc7194#section-1 + ;; https://www.iana.org/assignments/service-names-port-numbers (cond ((symbolp port) (erc-normalize-port (symbol-name port))) @@ -1554,8 +1559,10 @@ symbol, it may have these values: 194) ((string-equal port "ircs") 994) - ((string-equal port "ircd") + ((string-equal port "ircu") 6667) ; 6665-6669 + ((string-equal port "ircd") ; nonstandard (irc-serv is 529) 6667) + ((string-equal port "ircs-u") 6697) ((string-equal port "ircd-dalnet") 7000) (t @@ -1924,7 +1931,9 @@ removed from the list will be disabled." If CONNECT is non-nil, connect to the server. Otherwise assume already connected and just create a separate buffer for the new -target CHANNEL. +target given by CHANNEL, meaning these parameters are mutually +exclusive. Note that CHANNEL may also be a query; its name has +been retained for historical reasons. Use PASSWD as user password on the server. If TGT-LIST is non-nil, use it to initialize `erc-default-recipients'. @@ -2032,12 +2041,12 @@ Returns the buffer for the given server or channel." ;; Saving log file on exit (run-hook-with-args 'erc-connect-pre-hook buffer) - (when connect - (erc-server-connect erc-session-server - erc-session-port - buffer - erc-session-client-certificate)) - (erc-update-mode-line) + (if connect + (erc-server-connect erc-session-server + erc-session-port + buffer + erc-session-client-certificate) + (erc-update-mode-line)) ;; Now display the buffer in a window as per user wishes. (unless (eq buffer old-buffer) @@ -2094,52 +2103,51 @@ parameters SERVER and NICK." :group 'erc-hooks :type '(repeat function)) +(defun erc--ensure-url (input) + (unless (string-match (rx bot "irc" (? "6") (? "s") "://") input) + (when (and (string-match (rx (? (+ any) "@") + (or (group (* (not "[")) ":" (* any)) + (+ any)) + ":" (+ (not (any ":]"))) eot) + input) + (match-beginning 1)) + (setq input (concat "[" (substring input (match-beginning 1)) "]"))) + (setq input (concat "irc://" input))) + input) + ;;;###autoload (defun erc-select-read-args () "Prompt the user for values of nick, server, port, and password." - (let (user-input server port nick passwd) - (setq user-input (read-string - "IRC server: " - (erc-compute-server) 'erc-server-history-list)) - - (if (string-match "\\(.*\\):\\(.*\\)\\'" user-input) - (setq port (erc-string-to-port (match-string 2 user-input)) - user-input (match-string 1 user-input)) - (setq port - (erc-string-to-port (read-string - "IRC port: " (erc-port-to-string - (erc-compute-port)))))) - - (if (string-match "\\`\\(.*\\)@\\(.*\\)" user-input) - (setq nick (match-string 1 user-input) - user-input (match-string 2 user-input)) - (setq nick - (if (erc-already-logged-in server port nick) - (read-string - (erc-format-message 'nick-in-use ?n nick) - nick 'erc-nick-history-list) - (read-string - "Nickname: " (erc-compute-nick nick) - 'erc-nick-history-list)))) - - (setq server user-input) - - (setq passwd (if erc-prompt-for-password - (read-passwd "Server password: ") - (with-suppressed-warnings ((obsolete erc-password)) - erc-password))) + (require 'url-parse) + (let* ((input (let ((d (erc-compute-server))) + (read-string (format "Server (default is %S): " d) + nil 'erc-server-history-list d))) + ;; For legacy reasons, also accept a URL without a scheme. + (url (url-generic-parse-url (erc--ensure-url input))) + (server (url-host url)) + (sp (and (or (string-suffix-p "s" (url-type url)) + (and (equal server erc-default-server) + (not (string-prefix-p "irc://" input)))) + 'ircs-u)) + (port (or (url-portspec url) + (erc-compute-port + (let ((d (erc-compute-port sp))) ; may be a string + (read-string (format "Port (default is %s): " d) + nil nil d))))) + ;; Trust the user not to connect twice accidentally. We + ;; can't use `erc-already-logged-in' to check for an existing + ;; connection without modifying it to consider USER and PASS. + (nick (or (url-user url) + (let ((d (erc-compute-nick))) + (read-string (format "Nickname (default is %S): " d) + nil 'erc-nick-history-list d)))) + (passwd (or (url-password url) + (if erc-prompt-for-password + (read-passwd "Server password (optional): ") + (with-suppressed-warnings ((obsolete erc-password)) + erc-password))))) (when (and passwd (string= "" passwd)) (setq passwd nil)) - - (while (erc-already-logged-in server port nick) - ;; hmm, this is a problem when using multiple connections to a bnc - ;; with the same nick. Currently this code prevents using more than one - ;; bnc with the same nick. actually it would be nice to have - ;; bncs transparent, so that erc-compute-buffer-name displays - ;; the server one is connected to. - (setq nick (read-string - (erc-format-message 'nick-in-use ?n nick) - nick 'erc-nick-history-list))) (list :server server :port port :nick nick :password passwd))) ;;;###autoload @@ -2184,7 +2192,7 @@ interactively." ;;;###autoload (cl-defun erc-tls (&key (server (erc-compute-server)) - (port (erc-compute-port)) + (port (erc-compute-port 'ircs-u)) (nick (erc-compute-nick)) (user (erc-compute-user)) password @@ -3225,7 +3233,9 @@ host but different ports would result in the one with port 123 getting the nod. Much the same would happen for entries sharing only a port: the one with host foo would win." (when-let* - ((priority (map-keys defaults)) + ((auth-source-backend-parser-functions + (erc-compat--auth-source-backend-parser-functions)) + (priority (map-keys defaults)) (test (lambda (a b) (catch 'done (dolist (key priority) @@ -3802,17 +3812,17 @@ the message given by REASON." (put 'erc-cmd-GQUIT 'do-not-parse-args t) (put 'erc-cmd-GQUIT 'process-not-needed t) -(defun erc-cmd-RECONNECT () - "Try to reconnect to the current IRC server." +(defun erc--cmd-reconnect () (let ((buffer (erc-server-buffer)) (process nil)) (unless (buffer-live-p buffer) (setq buffer (current-buffer))) (with-current-buffer buffer + (when erc--server-reconnect-timer + (erc--cancel-auto-reconnect-timer)) (setq erc-server-quitting nil) (with-suppressed-warnings ((obsolete erc-server-reconnecting)) (setq erc-server-reconnecting t)) - (setq erc--server-reconnecting t) (setq erc-server-reconnect-count 0) (setq process (get-buffer-process (erc-server-buffer))) (when process @@ -3826,6 +3836,18 @@ the message given by REASON." (setq erc--server-reconnecting nil erc-server-reconnecting nil))))) t) + +(defun erc-cmd-RECONNECT (&rest args) + "Try reconnecting to the current IRC server. +Alternatively, CANCEL a scheduled attempt for either the current +connection or, with -A, all applicable connections. + +\(fn [CANCEL [-A]])" + (pcase args + (`("cancel" "-a") (erc-buffer-filter #'erc--cancel-auto-reconnect-timer)) + (`("cancel") (erc-with-server-buffer (erc--cancel-auto-reconnect-timer))) + (_ (erc--cmd-reconnect)))) + (put 'erc-cmd-RECONNECT 'process-not-needed t) (defun erc-cmd-SERVER (server) @@ -6391,7 +6413,7 @@ non-nil value is found. - PORT (the argument passed to this function) - The `erc-port' option - The `erc-default-port' variable" - (or port erc-port erc-default-port)) + (erc-normalize-port (or port erc-port erc-default-port))) ;; time routines @@ -6711,11 +6733,12 @@ shortened server name instead." (?s . ,(erc-format-target-and/or-server)) (?S . ,(erc-format-target-and/or-network)) (?t . ,(erc-format-target)))) - (process-status (cond ((and (erc-server-process-alive) - (not erc-server-connected)) - ":connecting") - ((erc-server-process-alive) - "") + (process-status (cond ((erc-server-process-alive buffer) + (unless erc-server-connected + ": connecting")) + ((erc-with-server-buffer + erc--server-reconnect-timer) + erc--mode-line-process-reconnecting) (t ": CLOSED"))) (face (cond ((eq erc-header-line-face-method nil) @@ -6726,7 +6749,7 @@ shortened server name instead." 'erc-header-line)))) (setq mode-line-buffer-identification (list (format-spec erc-mode-line-format spec))) - (setq mode-line-process (list process-status)) + (setq mode-line-process process-status) (let ((header (if erc-header-line-format (format-spec erc-header-line-format spec) nil))) @@ -6911,6 +6934,8 @@ All windows are opened in the current frame." (disconnected . "\n\nConnection failed! Re-establishing connection...\n") (disconnected-noreconnect . "\n\nConnection failed! Not re-establishing connection.\n") + (reconnecting . "Reconnecting in %ms: attempt %i/%n ...") + (reconnect-canceled . "Canceled %u reconnect timer with %cs to go...") (finished . "\n\n*** ERC finished ***\n") (terminated . "\n\n*** ERC terminated: %e\n") (login . "Logging in as `%n'...") @@ -7161,25 +7186,83 @@ This function should be on `erc-kill-channel-hook'." ;; Teach url.el how to open irc:// URLs with ERC. ;; To activate, customize `url-irc-function' to `url-irc-erc'. -;; FIXME change user to nick, and use API to find server buffer +(defcustom erc-url-connect-function nil + "When non-nil, a function used to connect to an IRC URL. +Called with a string meant to represent a URL scheme, like +\"ircs\", followed by any number of keyword arguments recognized +by `erc' and `erc-tls'." + :group 'erc + :package-version '(ERC . "5.4.1") ; FIXME increment on release + :type '(choice (const nil) function)) + +(defun erc--url-default-connect-function (scheme &rest plist) + (let* ((ircsp (if scheme + (string-suffix-p "s" scheme) + (or (eql 6697 (plist-get plist :port)) + (yes-or-no-p "Connect using TLS? ")))) + (erc-server (plist-get plist :server)) + (erc-port (or (plist-get plist :port) + (and ircsp (erc-normalize-port 'ircs-u)) + erc-port)) + (erc-nick (or (plist-get plist :nick) erc-nick)) + (erc-password (plist-get plist :password)) + (args (erc-select-read-args))) + (unless ircsp + (setq ircsp (eql 6697 erc-port))) + (apply (if ircsp #'erc-tls #'erc) args))) + ;;;###autoload -(defun erc-handle-irc-url (host port channel user password) - "Use ERC to IRC on HOST:PORT in CHANNEL as USER with PASSWORD. +(defun erc-handle-irc-url (host port channel nick password &optional scheme) + "Use ERC to IRC on HOST:PORT in CHANNEL. If ERC is already connected to HOST:PORT, simply /join CHANNEL. -Otherwise, connect to HOST:PORT as USER and /join CHANNEL." - (let ((server-buffer - (car (erc-buffer-filter - (lambda () - (and (string-equal erc-session-server host) - (= erc-session-port port) - (erc-open-server-buffer-p))))))) - (with-current-buffer (or server-buffer (current-buffer)) - (if (and server-buffer channel) - (erc-cmd-JOIN channel) - (erc-open host port (or user (erc-compute-nick)) (erc-compute-full-name) - (not server-buffer) password nil channel - (when server-buffer - (get-buffer-process server-buffer))))))) +Otherwise, connect to HOST:PORT as NICK and /join CHANNEL. + +Beginning with ERC 5.5, new connections require human intervention. +Customize `erc-url-connect-function' to override this." + (when (eql port 0) (setq port nil)) + (let* ((net (erc-networks--determine host)) + (server-buffer + ;; Viable matches may slip through the cracks for unknown + ;; networks. Additional passes could likely improve things. + (car (erc-buffer-filter + (lambda () + (and (not erc--target) + (erc-server-process-alive) + ;; Always trust a matched network. + (or (and net (eq net (erc-network))) + (and (string-equal erc-session-server host) + ;; Ports only matter when dialed hosts + ;; match and we have sufficient info. + (or (not port) + (= (erc-normalize-port erc-session-port) + port))))))))) + key deferred) + (unless server-buffer + (setq deferred t + server-buffer (apply (or erc-url-connect-function + #'erc--url-default-connect-function) + scheme + :server host + `(,@(and port (list :port port)) + ,@(and nick (list :nick nick)) + ,@(and password `(:password ,password)))))) + (when channel + ;; These aren't percent-decoded by default + (when (string-prefix-p "%" channel) + (setq channel (url-unhex-string channel))) + (cl-multiple-value-setq (channel key) (split-string channel "[?]")) + (if deferred + ;; Alternatively, we could make this a defmethod, so when + ;; autojoin is loaded, it can do its own thing. Also, as + ;; with `erc-once-with-server-event', it's fine to set local + ;; hooks here because they're killed when reconnecting. + (with-current-buffer server-buffer + (letrec ((f (lambda (&rest _) + (remove-hook 'erc-after-connect f t) + (erc-cmd-JOIN channel key)))) + (add-hook 'erc-after-connect f nil t))) + (with-current-buffer server-buffer + (erc-cmd-JOIN channel key)))))) (provide 'erc) diff --git a/lisp/eshell/em-prompt.el b/lisp/eshell/em-prompt.el index a1a91e7d634..a8744de1dba 100644 --- a/lisp/eshell/em-prompt.el +++ b/lisp/eshell/em-prompt.el @@ -100,6 +100,14 @@ arriving, or after." "C-c C-n" #'eshell-next-prompt "C-c C-p" #'eshell-previous-prompt) +(defvar-keymap eshell-prompt-repeat-map + :doc "Keymap to repeat eshell-prompt key sequences. Used in `repeat-mode'." + "C-n" #'eshell-next-prompt + "C-p" #'eshell-previous-prompt) + +(put #'eshell-next-prompt 'repeat-map 'eshell-prompt-repeat-map) +(put #'eshell-previous-prompt 'repeat-map 'eshell-prompt-repeat-map) + ;;; Functions: (define-minor-mode eshell-prompt-mode diff --git a/lisp/eshell/esh-mode.el b/lisp/eshell/esh-mode.el index 92523fd99ea..4357a0e29a0 100644 --- a/lisp/eshell/esh-mode.el +++ b/lisp/eshell/esh-mode.el @@ -280,6 +280,14 @@ This is used by `eshell-watch-for-password-prompt'." "C-w" #'backward-kill-word "C-y" #'eshell-repeat-argument) +(defvar-keymap eshell-command-repeat-map + :doc "Keymap to repeat eshell-command key sequences. Used in `repeat-mode'." + "C-f" #'eshell-forward-argument + "C-b" #'eshell-backward-argument) + +(put #'eshell-forward-argument 'repeat-map 'eshell-command-repeat-map) +(put #'eshell-backward-argument 'repeat-map 'eshell-command-repeat-map) + ;;; User Functions: (defun eshell-kill-buffer-function () diff --git a/lisp/eshell/esh-proc.el b/lisp/eshell/esh-proc.el index bb928fc5fb0..950922ea7f8 100644 --- a/lisp/eshell/esh-proc.el +++ b/lisp/eshell/esh-proc.el @@ -552,7 +552,7 @@ See the variable `eshell-kill-processes-on-exit'." (setq sigs (cdr sigs)))))) (defun eshell-query-kill-processes () - "Kill processes belonging to the current Eshell buffer, possibly w/ query." + "Kill processes belonging to the current Eshell buffer, possibly with query." (when (and eshell-kill-processes-on-exit eshell-process-list) (save-window-excursion diff --git a/lisp/eshell/esh-util.el b/lisp/eshell/esh-util.el index ecb6888651f..0ec11e8a0b3 100644 --- a/lisp/eshell/esh-util.el +++ b/lisp/eshell/esh-util.el @@ -296,7 +296,7 @@ directories separated by `path-separator'." (if (listp path) path ;; Don't use `parse-colon-path' here, since we don't want - ;; the additonal translations it does on each element. + ;; the additional translations it does on each element. (split-string path (path-separator)))))) (defun eshell-parse-colon-path (path-env) diff --git a/lisp/face-remap.el b/lisp/face-remap.el index 432385587b4..a6920150941 100644 --- a/lisp/face-remap.el +++ b/lisp/face-remap.el @@ -367,7 +367,7 @@ See `text-scale-increase' for more details." ;;;###autoload (defun text-scale-adjust (inc) "Adjust the font size in the current buffer by INC steps. -INC may be passed as a numeric prefix argument. +Interactively, INC is the prefix numeric argument, and defaults to 1. The actual adjustment made depends on the final component of the keybinding used to invoke the command, with all modifiers removed: @@ -377,13 +377,14 @@ keybinding used to invoke the command, with all modifiers removed: \\`0' Reset the font size to the global default After adjusting, continue to read input events and further adjust -the font size as long as the input event read -\(with all modifiers removed) is one of the above characters. +the font size as long as the input event (with all modifiers removed) +is one of the above characters. -Each step scales the height of the default face by the variable -`text-scale-mode-step' (a negative number of steps decreases the -height by the same amount). As a special case, an argument of 0 -will remove any scaling currently active. +Each step scales the height of the default face by the factor that +is the value of `text-scale-mode-step' (a negative number of steps +decreases the height by that factor). As a special case, an argument +of 0 will remove any scaling currently active, thus resetting the +font size to the original value. This command is a special-purpose wrapper around the `text-scale-increase' command which makes repetition convenient @@ -396,7 +397,11 @@ that have an explicit `:height' setting. The two exceptions to this are the `default' and `header-line' faces: they will both be scaled even if they have an explicit `:height' setting. -See also the related command `global-text-scale-adjust'." +See also the related command `global-text-scale-adjust'. Unlike +that command, which scales the font size with a increment, +`text-scale-adjust' scales the font size with a factor, +`text-scale-mode-step'. With a small `text-scale-mode-step' +factor, the two commands behave similarly." (interactive "p") (let ((ev last-command-event) (echo-keystrokes nil)) @@ -461,25 +466,30 @@ the `cdr' has the maximum font size, in units of 1/10 pt." (defvar global-text-scale-adjust--default-height nil) +(defvar global-text-scale-adjust--increment-factor 5) + ;;;###autoload (define-key ctl-x-map [(control meta ?+)] 'global-text-scale-adjust) ;;;###autoload (define-key ctl-x-map [(control meta ?=)] 'global-text-scale-adjust) ;;;###autoload (define-key ctl-x-map [(control meta ?-)] 'global-text-scale-adjust) ;;;###autoload (define-key ctl-x-map [(control meta ?0)] 'global-text-scale-adjust) ;;;###autoload (defun global-text-scale-adjust (increment) - "Globally adjust the font size by INCREMENT. + "Change (a.k.a. \"adjust\") the font size of all faces by INCREMENT. -Interactively, INCREMENT may be passed as a numeric prefix argument. +Interactively, INCREMENT is the prefix numeric argument, and defaults +to 1. Positive values of INCREMENT increase the font size, negative +values decrease it. -The adjustment made depends on the final component of the key binding -used to invoke the command, with all modifiers removed: +When you invoke this command, it performs the initial change of the +font size, and after that allows further changes by typing one of the +following keys immediately after invoking the command: \\`+', \\`=' Globally increase the height of the default face \\`-' Globally decrease the height of the default face \\`0' Globally reset the height of the default face -After adjusting, further adjust the font size as long as the key, -with all modifiers removed, is one of the above characters. +(The change of the font size produced by these keys depends on the +final component of the key sequence, with all modifiers removed.) Buffer-local face adjustments have higher priority than global face adjustments. @@ -488,7 +498,10 @@ The variable `global-text-scale-adjust-resizes-frames' controls whether the frames are resized to keep the same number of lines and characters per line when the font size is adjusted. -See also the related command `text-scale-adjust'." +See also the related command `text-scale-adjust'. Unlike that +command, which scales the font size with a factor, +`global-text-scale-adjust' scales the font size with an +increment." (interactive "p") (when (display-graphic-p) (unless global-text-scale-adjust--default-height @@ -499,16 +512,24 @@ See also the related command `text-scale-adjust'." (cur (face-attribute 'default :height)) (inc (pcase key - (?- (* (- increment) 5)) + (?- (* (- increment) + global-text-scale-adjust--increment-factor)) (?0 (- global-text-scale-adjust--default-height cur)) - (_ (* increment 5)))) + (_ (* increment + global-text-scale-adjust--increment-factor)))) (new (+ cur inc))) (when (< (car global-text-scale-adjust-limits) new (cdr global-text-scale-adjust-limits)) (let ((frame-inhibit-implied-resize (not global-text-scale-adjust-resizes-frames))) - (set-face-attribute 'default nil :height new))) + (set-face-attribute 'default nil :height new) + (redisplay 'force) + (when (and (not (and (characterp key) (= key ?0))) + (= cur (face-attribute 'default :height))) + (setq global-text-scale-adjust--increment-factor + (1+ global-text-scale-adjust--increment-factor)) + (global-text-scale-adjust increment)))) (when (characterp key) (set-transient-map (let ((map (make-sparse-keymap))) diff --git a/lisp/faces.el b/lisp/faces.el index 09e81104491..c69339e2fdc 100644 --- a/lisp/faces.el +++ b/lisp/faces.el @@ -787,13 +787,12 @@ specified below. WIDTH specifies the width of the lines to draw; it defaults to 1. If WIDTH is negative, the absolute value is the width of the lines, and draw top/bottom lines inside the characters area, not around it. COLOR is the name of the color to draw in, default is -the foreground color of the face for simple boxes, and the background -color of the face for 3D boxes. STYLE specifies whether a 3D box -should be draw. If STYLE is `released-button', draw a box looking -like a released 3D button. If STYLE is `pressed-button' draw a box -that appears like a pressed button. If STYLE is nil, the default if -the property list doesn't contain a style specification, draw a 2D -box. +the background color of the face for 3D boxes and `flat-button', and +the foreground color of the face for other boxes. STYLE specifies +whether a 3D box should be draw. If STYLE is `released-button', draw +a box looking like a released 3D button. If STYLE is `pressed-button' +draw a box that appears like a pressed button. If STYLE is nil, +`flat-button' or omitted, draw a 2D box. `:inverse-video' @@ -2201,8 +2200,13 @@ the X resource \"reverseVideo\" is present, handle that." border-color cursor-color mouse-color visibility scroll-bar-foreground scroll-bar-background)) + (delayed-font nil) frame success) (dolist (param delayed-params) + ;; Save the font used here. Once the frame is created, set the + ;; `font-parameter' frame parameter. + (when (and (eq param 'font) (assq 'font parameters)) + (setq delayed-font (cdr (assq 'font parameters)))) (setq params (assq-delete-all param params))) (setq frame (x-create-frame `((visibility . nil) . ,params))) (unwind-protect @@ -2213,6 +2217,11 @@ the X resource \"reverseVideo\" is present, handle that." (x-handle-reverse-video frame parameters) (frame-set-background-mode frame t) (face-set-after-frame-default frame parameters) + ;; The code above will not set the `font-parameter' frame + ;; property, which is used by dynamic-setting.el to respect + ;; fonts specified by the user via frame parameters (as + ;; opposed to face attributes). Set the parameter manually. + (set-frame-parameter frame 'font-parameter delayed-font) ;; Mark frame as 'was-invisible' when it was created as ;; invisible or iconified and PARAMETERS contains either a ;; width or height specification. This should be sufficient diff --git a/lisp/files.el b/lisp/files.el index a2825322580..b947451369c 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -7294,7 +7294,7 @@ by `sh' are supported." (setq i (1+ i)) "[]")) (t "[")) - (prog1 ; copy everything upto next `]'. + (prog1 ; copy everything up to next `]'. (substring wildcard i (setq j (string-search diff --git a/lisp/filesets.el b/lisp/filesets.el index aeebd907c35..9f07072e787 100644 --- a/lisp/filesets.el +++ b/lisp/filesets.el @@ -2390,6 +2390,7 @@ fileset thinks this is necessary or not." (filesets-menu-cache-file-load)) (defun filesets-update-pre010505 () + (declare (obsolete nil "29.1")) (let ((msg (format-message "Filesets: manual editing of user data required! @@ -2435,7 +2436,8 @@ We apologize for the inconvenience."))) ((or (not cached-version) (string< cached-version "1.5.5") (boundp 'filesets-subdocument-patterns)) - (filesets-update-pre010505))) + (with-suppressed-warnings ((obsolete filesets-update-pre010505)) + (filesets-update-pre010505)))) (filesets-update-cleanup)) (defun filesets-menu-cache-file-load () diff --git a/lisp/forms.el b/lisp/forms.el index b97fdbe04c8..97c7cb79d3a 100644 --- a/lisp/forms.el +++ b/lisp/forms.el @@ -487,17 +487,11 @@ Commands: Equivalent keys in read-only mode: (make-local-variable 'forms-insert-after) (make-local-variable 'forms-use-text-properties) - ;; Filter functions. - (make-local-variable 'forms-read-file-filter) - (make-local-variable 'forms-write-file-filter) - (make-local-variable 'forms-new-record-filter) - (make-local-variable 'forms-modified-record-filter) - - ;; Make sure no filters exist. - (setq forms-read-file-filter nil) - (setq forms-write-file-filter nil) - (setq forms-new-record-filter nil) - (setq forms-modified-record-filter nil) + ;; Make sure no filters exist. + (setq-local forms-read-file-filter nil) + (setq-local forms-write-file-filter nil) + (setq-local forms-new-record-filter nil) + (setq-local forms-modified-record-filter nil) ;; Setup faces to show read-only and read-write fields. (make-local-variable 'forms-ro-face) @@ -615,10 +609,10 @@ Commands: Equivalent keys in read-only mode: (make-local-variable 'forms--the-record-list) (make-local-variable 'forms--search-regexp) - ; The keymaps are global, so multiple forms mode buffers can share them. - ;(make-local-variable 'forms-mode-map) - ;(make-local-variable 'forms-mode-ro-map) - ;(make-local-variable 'forms-mode-edit-map) + ;; The keymaps are global, so multiple forms mode buffers can share them. + ;;(make-local-variable 'forms-mode-map) + ;;(make-local-variable 'forms-mode-ro-map) + ;;(make-local-variable 'forms-mode-edit-map) (if forms-mode-map ; already defined nil ;;(message "forms: building keymap...") @@ -715,8 +709,8 @@ Commands: Equivalent keys in read-only mode: ;;(message "forms: setting up... done.") ;; be helpful - (forms--help) -) + (forms--help)) + (defun forms--process-format-list () ;; Validate `forms-format-list' and set some global variables. diff --git a/lisp/gnus/ChangeLog.1 b/lisp/gnus/ChangeLog.1 index 1949f626091..002b7bcfff6 100644 --- a/lisp/gnus/ChangeLog.1 +++ b/lisp/gnus/ChangeLog.1 @@ -910,7 +910,7 @@ 1998-07-11 Mike McEwan <mike@lotusland.demon.co.uk> * gnus-agent.el (gnus-agent-fetch-headers): Note last fetched - headers per sesion to aid expiry in `headers only' groups. + headers per session to aid expiry in `headers only' groups. * gnus-agent.el (gnus-agent-expire): Update group info to add expired articles to list of read articles and prevent diff --git a/lisp/gnus/ChangeLog.3 b/lisp/gnus/ChangeLog.3 index c33c76f68d0..c55d6225e3f 100644 --- a/lisp/gnus/ChangeLog.3 +++ b/lisp/gnus/ChangeLog.3 @@ -4243,7 +4243,7 @@ * gnus-msg.el (gnus-inews-do-gcc): * message.el (message-send-mail): * mml.el (mml-generate-mime): Share the value of the buffer-local - `message-options' variable between a draft buffer and temprary working + `message-options' variable between a draft buffer and temporary working buffers. 2011-11-30 Stefan Monnier <monnier@iro.umontreal.ca> @@ -4902,7 +4902,7 @@ 2011-07-31 Marcus Harnisch <marcus.harnisch@gmx.net> (tiny change) * gnus-art.el (gnus-article-stop-animations): Use `elt' instead of - `aref' for XEmacs compatibiltiy. + `aref' for XEmacs compatibility. 2011-07-31 Lars Magne Ingebrigtsen <larsi@gnus.org> @@ -10876,7 +10876,7 @@ 2010-09-20 Lars Magne Ingebrigtsen <larsi@gnus.org> * gnus-group.el (gnus-group-line-format-alist): Have the ?U (unseen) - spec inser "*" if the group isn't active instead of 0. + spec insert "*" if the group isn't active instead of 0. * nnimap.el (nnimap-request-group): Don't select the imap buffer before opening the server. @@ -23276,7 +23276,7 @@ Signal a specific `search-failed' rather than a generic `error'. * gnus-salt.el (gnus-pick-mouse-pick-region): Switch 1 => point-min. - (gnus-generate-vertical-tree): Usue `bobp' rather than compare to 1. + (gnus-generate-vertical-tree): Use `bobp' rather than compare to 1. (gnus-highlight-selected-tree): Use point-min rather than 1 and 2. 2004-09-10 Simon Josefsson <jas@extundo.com> diff --git a/lisp/gnus/gnus-group.el b/lisp/gnus/gnus-group.el index e69f0857e77..c7ec65da79a 100644 --- a/lisp/gnus/gnus-group.el +++ b/lisp/gnus/gnus-group.el @@ -393,17 +393,15 @@ variables in the Lisp expression: "Add Icons to your group buffer." :group 'gnus-group-visual) -(defcustom gnus-group-icon-list - nil +(defcustom gnus-group-icon-list nil "Controls the insertion of icons into group buffer lines. Below is a list of `Form'/`File' pairs. When deciding how a particular group line should be displayed, each form is evaluated. The icon from the file field after the first true form is used. You can change how those group lines are displayed by editing the file -field. The File will either be found in the -`gnus-group-glyph-directory' or by designating absolute name of the -file. +field. The File will either be found in the `image-load-path' +or by specifying the absolute name of the file. It is also possible to change and add form fields, but currently that requires an understanding of Lisp expressions. Hopefully this will diff --git a/lisp/gnus/gnus-search.el b/lisp/gnus/gnus-search.el index b8f7e7a08f0..7941496be61 100644 --- a/lisp/gnus/gnus-search.el +++ b/lisp/gnus/gnus-search.el @@ -1943,7 +1943,7 @@ Assume \"size\" key is equal to \"larger\"." (thread (alist-get 'thread query))) (with-slots (switches config-directory) engine `("find" ; command must come first - "--nocolor" ; mu will always give coloured output otherwise + "--nocolor" ; mu will always give colored output otherwise ,(format "--muhome=%s" config-directory) ,@switches ,(if thread "-r" "") diff --git a/lisp/gnus/gnus-start.el b/lisp/gnus/gnus-start.el index 4963fd083f7..a4962f9d5f0 100644 --- a/lisp/gnus/gnus-start.el +++ b/lisp/gnus/gnus-start.el @@ -173,7 +173,7 @@ properly with all servers." Groups with levels less than `gnus-level-subscribed', which should be less than this variable, are subscribed. Groups with -levels from `gnus-level-subscribed' (exclusive) upto this +levels from `gnus-level-subscribed' (exclusive) up to this variable (inclusive) are unsubscribed. See also `gnus-level-zombie', `gnus-level-killed' and the Info node `(gnus)Group Levels' for details.") diff --git a/lisp/gnus/mml.el b/lisp/gnus/mml.el index e8291cfe6f7..ebd0adf2e25 100644 --- a/lisp/gnus/mml.el +++ b/lisp/gnus/mml.el @@ -1446,7 +1446,7 @@ will be computed and used." (mml-insert-empty-tag 'part 'type type ;; icicles redefines read-file-name and returns a - ;; string w/ text properties :-/ + ;; string with text properties :-/ 'filename (substring-no-properties file) 'disposition (or disposition "attachment") 'description description) diff --git a/lisp/gnus/nnimap.el b/lisp/gnus/nnimap.el index 73cd183a02a..8392eb601ff 100644 --- a/lisp/gnus/nnimap.el +++ b/lisp/gnus/nnimap.el @@ -238,7 +238,7 @@ during splitting, which may be slow." (with-current-buffer (nnimap-buffer) (erase-buffer) ;; If we have a lot of ranges, split them up to avoid - ;; generating too-long lines. (The limit is 8192 octects, + ;; generating too-long lines. (The limit is 8192 octets, ;; and this should guarantee that it's (much) shorter than ;; that.) We don't stream the requests, since the server ;; may respond to the requests out-of-order: diff --git a/lisp/gnus/nnrss.el b/lisp/gnus/nnrss.el index 99e7b2a6f3f..66cee528659 100644 --- a/lisp/gnus/nnrss.el +++ b/lisp/gnus/nnrss.el @@ -77,7 +77,7 @@ this variable to the list of fields to be ignored.") "List of RSS addresses.") (defvar nnrss-use-local nil - "If non-nil nnrss will read the feeds from local files in nnrss-directory.") + "If non-nil nnrss will read the feeds from local files in `nnrss-directory'.") (defvar nnrss-description-field 'X-Gnus-Description "Field name used for DESCRIPTION. @@ -398,7 +398,7 @@ otherwise return nil." (declare-function libxml-parse-html-region "xml.c" (start end &optional base-url discard-comments)) (defun nnrss-fetch (url &optional local) - "Fetch URL and put it in a the expected Lisp structure." + "Fetch URL and put it in the expected Lisp structure." (mm-with-unibyte-buffer ;;some versions of url.el need this to close the connection quickly (let (cs xmlform htmlform) @@ -800,7 +800,7 @@ It is useful when `(setq nnrss-use-local t)'." node)) (defun nnrss-find-el (tag data &optional found-list) - "Find the all matching elements in the data. + "Find all the matching elements in the data. Careful with this on large documents!" (when (consp data) (dolist (bit data) diff --git a/lisp/gnus/nnvirtual.el b/lisp/gnus/nnvirtual.el index e150cbf2b46..eec0347bcff 100644 --- a/lisp/gnus/nnvirtual.el +++ b/lisp/gnus/nnvirtual.el @@ -172,7 +172,7 @@ It is computed from the marks of individual component groups.") (with-current-buffer nntp-server-buffer (erase-buffer) (insert-buffer-substring vbuf) - ;; FIX FIX FIX, we should be able to sort faster than + ;; FIXME: we should be able to sort faster than ;; this if needed, since each cgroup is sorted, we just ;; need to merge (sort-numeric-fields 1 (point-min) (point-max)) diff --git a/lisp/help.el b/lisp/help.el index b25a8ce2995..f956111a52f 100644 --- a/lisp/help.el +++ b/lisp/help.el @@ -1945,10 +1945,7 @@ of a horizontal combination, restrain its new size by `fit-window-to-buffer-horizontally' can inhibit resizing. If WINDOW is the root window of its frame, resize the frame -provided `fit-frame-to-buffer' is non-nil. - -This function may call `preserve-window-size' to preserve the -size of WINDOW." +provided `fit-frame-to-buffer' is non-nil." (setq window (window-normalize-window window t)) (let* ((buffer (window-buffer window)) (height (if (functionp temp-buffer-max-height) diff --git a/lisp/htmlfontify.el b/lisp/htmlfontify.el index 34092b1417e..df4c6ab079c 100644 --- a/lisp/htmlfontify.el +++ b/lisp/htmlfontify.el @@ -1937,7 +1937,7 @@ Otherwise, the link should be to the index file. We are not yet concerned with the file extensions/tag line number and so on at this point. -If `hfy-split-index' is set, and the href wil be to an index file rather than +If `hfy-split-index' is set, and the href will be to an index file rather than a source file, append a .X to `hfy-index-file', where X is the uppercased first character of TAG. diff --git a/lisp/icomplete.el b/lisp/icomplete.el index 0a63e0a1dd5..ef710d582d3 100644 --- a/lisp/icomplete.el +++ b/lisp/icomplete.el @@ -228,7 +228,7 @@ the default otherwise." ;; Apropos `icomplete-scroll', we implement "scrolling icomplete" ;; within classic icomplete, which is "rotating", by contrast. ;; -;; The two variables supporing this are +;; The two variables supporting this are ;; `icomplete--scrolled-completions' and `icomplete--scrolled-past'. ;; They come into play when: ;; diff --git a/lisp/info.el b/lisp/info.el index 02dde50dd6a..8860a664bd7 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -2666,7 +2666,7 @@ new buffer." (defconst Info-menu-entry-name-re "\\(?:[^:]\\|:[^:,.;() \t\n]\\)*" ;; We allow newline because this is also used in Info-follow-reference, ;; where the xref name might be wrapped over two lines. - "Regexp that matches a menu entry name upto but not including the colon. + "Regexp that matches a menu entry name up to but not including the colon. Because of ambiguities, this should be concatenated with something like `:' and `Info-following-node-name-re'.") diff --git a/lisp/international/titdic-cnv.el b/lisp/international/titdic-cnv.el index d2a6ee1e9d1..b942f5fabc2 100644 --- a/lisp/international/titdic-cnv.el +++ b/lisp/international/titdic-cnv.el @@ -59,6 +59,13 @@ ;; Near the end of this file, we also have a few other tools to convert ;; miscellaneous dictionaries. +;; Note: This file includes several codepoints outside of the Unicode +;; 0..#x10FFFF range, which are characters that were not unified into +;; Unicode. Therefore, this file is encoded in utf-8-emacs, because +;; UTF-8 cannot encode such codepoints. We include these codepoints +;; literally in the file to have them displayed by suitable fonts, +;; which makes maintenance easier. + ;;; Code: (require 'quail) diff --git a/lisp/keymap.el b/lisp/keymap.el index 107565590c1..eaeba966444 100644 --- a/lisp/keymap.el +++ b/lisp/keymap.el @@ -559,22 +559,45 @@ In addition to the keywords accepted by `define-keymap', this macro also accepts a `:doc' keyword, which (if present) is used as the variable documentation string. -\(fn VARIABLE-NAME &key DOC FULL PARENT SUPPRESS NAME PREFIX KEYMAP &rest [KEY DEFINITION]...)" +The `:repeat' keyword can also be specified; it controls the +`repeat-mode' behavior of the bindings in the keymap. When it is +non-nil, all commands in the map will have the `repeat-map' +symbol property. + +More control is available over which commands are repeatable; the +value can also be a property list with properties `:enter' and +`:exit', for example: + + :repeat (:enter (commands ...) :exit (commands ...)) + +`:enter' specifies the list of additional commands that only +enter `repeat-mode'. When the list is empty, then by default all +commands in the map enter `repeat-mode'. This is useful when +there is a command that has the `repeat-map' symbol property, but +doesn't exist in this specific map. `:exit' is a list of +commands that exit `repeat-mode'. When the list is empty, no +commands in the map exit `repeat-mode'. This is useful when a +command exists in this specific map, but it doesn't have the +`repeat-map' symbol property on its symbol. + +\(fn VARIABLE-NAME &key DOC FULL PARENT SUPPRESS NAME PREFIX KEYMAP REPEAT &rest [KEY DEFINITION]...)" (declare (indent 1)) (let ((opts nil) - doc) + doc repeat props) (while (and defs (keywordp (car defs)) (not (eq (car defs) :menu))) (let ((keyword (pop defs))) (unless defs (error "Uneven number of keywords")) - (if (eq keyword :doc) - (setq doc (pop defs)) - (push keyword opts) - (push (pop defs) opts)))) + (cond + ((eq keyword :doc) (setq doc (pop defs))) + ((eq keyword :repeat) (setq repeat (pop defs))) + (t (push keyword opts) + (push (pop defs) opts))))) (unless (zerop (% (length defs) 2)) (error "Uneven number of key/definition pairs: %s" defs)) + (let ((defs defs) key seen-keys) (while defs @@ -585,9 +608,28 @@ as the variable documentation string. (error "Duplicate definition for key '%s' in keymap '%s'" key variable-name) (push key seen-keys))))) - `(defvar ,variable-name - (define-keymap ,@(nreverse opts) ,@defs) - ,@(and doc (list doc))))) + + (when repeat + (let ((defs defs) + def) + (dolist (def (plist-get repeat :enter)) + (push `(put ',def 'repeat-map ',variable-name) props)) + (while defs + (pop defs) + (setq def (pop defs)) + (when (and (memq (car def) '(function quote)) + (not (memq (cadr def) (plist-get repeat :exit)))) + (push `(put ,def 'repeat-map ',variable-name) props))))) + + (let ((defvar-form + `(defvar ,variable-name + (define-keymap ,@(nreverse opts) ,@defs) + ,@(and doc (list doc))))) + (if repeat + `(progn + ,defvar-form + ,@(nreverse props)) + defvar-form)))) (defun make-non-key-event (symbol) "Mark SYMBOL as an event that shouldn't be returned from `where-is'." diff --git a/lisp/language/ethio-util.el b/lisp/language/ethio-util.el index 2f76acfe7cb..5b4252d779c 100644 --- a/lisp/language/ethio-util.el +++ b/lisp/language/ethio-util.el @@ -30,6 +30,13 @@ ;;; Commentary: +;; Note: This file includes several codepoints outside of the Unicode +;; 0..#x10FFFF range, which are characters that were not unified into +;; Unicode. Therefore, this file is encoded in utf-8-emacs, because +;; UTF-8 cannot encode such codepoints. We include these codepoints +;; literally in the file to have them displayed by suitable fonts, +;; which makes maintenance easier. + ;;; Code: (require 'robin) @@ -105,6 +112,8 @@ (defcustom ethio-primary-language 'tigrigna "Symbol that defines the primary language in SERA --> FIDEL conversion. +FIDEL is the Amharic alphabet; SERA (System for Ethiopic Representation +in ASCII) is the Latin representation of Ethiopic script. The value should be one of: `tigrigna', `amharic' or `english'." :version "28.1" :type '(choice (const :tag "Tigrigna" tigrigna) @@ -113,6 +122,8 @@ The value should be one of: `tigrigna', `amharic' or `english'." (defcustom ethio-secondary-language 'english "Symbol that defines the secondary language in SERA --> FIDEL conversion. +FIDEL is the Amharic alphabet; SERA (System for Ethiopic Representation +in ASCII) is the Latin representation of Ethiopic script. The value should be one of: `tigrigna', `amharic' or `english'." :version "28.1" :type '(choice (const :tag "Tigrigna" tigrigna) @@ -123,7 +134,9 @@ The value should be one of: `tigrigna', `amharic' or `english'." "Non-nil means associate ASCII colon with Ethiopic colon. If nil, associate ASCII colon with Ethiopic word separator, i.e., two vertically stacked dots. All SERA <--> FIDEL converters refer this -variable." +variable. +FIDEL is the Amharic alphabet; SERA (System for Ethiopic Representation +in ASCII) is the Latin representation of Ethiopic script." :version "28.1" :type 'boolean) @@ -131,7 +144,9 @@ variable." "If non-nil, associate ASCII question mark with Ethiopic question mark. The Ethiopic old style question mark is three vertically stacked dots. If nil, associate ASCII question mark with Ethiopic stylized question -mark. All SERA <--> FIDEL converters refer this variable." +mark. All SERA <--> FIDEL converters refer this variable. +FIDEL is the Amharic alphabet; SERA (System for Ethiopic Representation +in ASCII) is the Latin representation of Ethiopic script." :version "28.1" :type 'boolean) @@ -140,13 +155,17 @@ mark. All SERA <--> FIDEL converters refer this variable." This happens in FIDEL --> SERA conversions. Isolated vowels at word beginning do not get an apostrophe put before them. If nil, put an apostrophe only between a 6th-form consonant and an -isolated vowel." +isolated vowel. +FIDEL is the Amharic alphabet; SERA (System for Ethiopic Representation +in ASCII) is the Latin representation of Ethiopic script." :version "28.1" :type 'boolean) (defcustom ethio-W-sixth-always nil "Non-nil means convert the Wu-form of a 12-form consonant to \"W'\". -This is instead of \"Wu\" in FIDEL --> SERA conversion." +This is instead of \"Wu\" in FIDEL --> SERA conversion. +FIDEL is the Amharic alphabet; SERA (System for Ethiopic Representation +in ASCII) is the Latin representation of Ethiopic script." :version "28.1" :type 'boolean) @@ -216,6 +235,8 @@ If nil, use uppercases." (defun ethio-sera-to-fidel-buffer (&optional secondary force) "Convert the current buffer from SERA to FIDEL. +FIDEL is the Amharic alphabet; SERA (System for Ethiopic Representation +in ASCII) is the Latin representation of Ethiopic script. The variable `ethio-primary-language' specifies the primary language and `ethio-secondary-language' specifies the secondary. @@ -241,6 +262,8 @@ See also the descriptions of the variables (defun ethio-sera-to-fidel-region (begin end &optional secondary force) "Convert the characters in region from SERA to FIDEL. +FIDEL is the Amharic alphabet; SERA (System for Ethiopic Representation +in ASCII) is the Latin representation of Ethiopic script. The variable `ethio-primary-language' specifies the primary language and `ethio-secondary-language' specifies the secondary. @@ -496,7 +519,9 @@ changing anything." ;;;###autoload (defun ethio-sera-to-fidel-marker (&optional force) - "Convert the regions surrounded by \"<sera>\" and \"</sera>\" from SERA to FIDEL. + "Convert regions surrounded by \"<sera>\" and \"</sera>\" from SERA to FIDEL. +FIDEL is the Amharic alphabet; SERA (System for Ethiopic Representation +in ASCII) is the Latin representation of Ethiopic script. Assume that each region begins with `ethio-primary-language'. The markers \"<sera>\" and \"</sera>\" themselves are not deleted." (interactive "P") @@ -528,7 +553,9 @@ The markers \"<sera>\" and \"</sera>\" themselves are not deleted." ;;;###autoload (defun ethio-fidel-to-sera-buffer (&optional secondary force) - "Replace all the FIDEL characters in the current buffer to the SERA format. + "Convert all the FIDEL characters in the current buffer to the SERA format. +FIDEL is the Amharic alphabet; SERA (System for Ethiopic Representation +in ASCII) is the Latin representation of Ethiopic script. The variable `ethio-primary-language' specifies the primary language and `ethio-secondary-language' specifies the secondary. @@ -548,8 +575,10 @@ See also the descriptions of the variables ;;;###autoload (defun ethio-fidel-to-sera-region (begin end &optional secondary force) - "Replace all the FIDEL characters in the region to the SERA format. + "Convert all the FIDEL characters in the region to the SERA format. +FIDEL is the Amharic alphabet; SERA (System for Ethiopic Representation +in ASCII) is the Latin representation of Ethiopic script. The variable `ethio-primary-language' specifies the primary language and `ethio-secondary-language' specifies the secondary. @@ -667,6 +696,8 @@ See also the descriptions of the variables ;;;###autoload (defun ethio-fidel-to-sera-marker (&optional force) "Convert the regions surrounded by \"<sera>\" and \"</sera>\" from FIDEL to SERA. +FIDEL is the Amharic alphabet; SERA (System for Ethiopic Representation +in ASCII) is the Latin representation of Ethiopic script. The markers \"<sera>\" and \"</sera>\" themselves are not deleted." (interactive "P") @@ -691,7 +722,8 @@ The markers \"<sera>\" and \"</sera>\" themselves are not deleted." ;;;###autoload (defun ethio-modify-vowel nil - "Modify the vowel of the FIDEL that is under the cursor." + "Modify the vowel of the FIDEL that is under the cursor. +FIDEL is the Amharic/Ethiopic alphabet." (interactive) (ethio-adjust-robin) (let ((consonant (ethio-get-consonant (following-char))) @@ -708,7 +740,9 @@ The markers \"<sera>\" and \"</sera>\" themselves are not deleted." (robin-convert-region (point-min) (point-max) "ethiopic-sera")))))) (defun ethio-get-consonant (ch) - "Return the consonant part of CH's SERA spelling in ethiopic-sera." + "Return the consonant part of CH's SERA spelling in ethiopic-sera. +SERA (System for Ethiopic Representation in ASCII) is the Latin +representation of Ethiopic script." (let ((sera (get-char-code-property ch 'ethiopic-sera))) (cond ((null sera) nil) @@ -813,7 +847,8 @@ The 2nd and 3rd arguments BEGIN and END specify the region." ;;;###autoload (defun ethio-fidel-to-tex-buffer nil - "Convert each fidel characters in the current buffer into a fidel-tex command." + "Convert each FIDEL characters in the current buffer into a fidel-tex command. +FIDEL is the Amharic/Ethiopic alphabet." (interactive) (let ((buffer-read-only nil) comp) @@ -860,7 +895,8 @@ The 2nd and 3rd arguments BEGIN and END specify the region." ;;;###autoload (defun ethio-tex-to-fidel-buffer () - "Convert fidel-tex commands in the current buffer into fidel chars." + "Convert fidel-tex commands in the current buffer into FIDEL chars. +FIDEL is the Amharic/Ethiopic alphabet." (interactive) (let ((inhibit-read-only t) ;; (p) (ch) @@ -888,7 +924,7 @@ The 2nd and 3rd arguments BEGIN and END specify the region." ;;;###autoload (defun ethio-fidel-to-java-buffer nil - "Convert Ethiopic characters into the Java escape sequences. + "Convert Ethiopic characters in the buffer into the Java escape sequences. Each escape sequence is of the form \\uXXXX, where XXXX is the character's codepoint (in hex) in Unicode. @@ -907,7 +943,7 @@ Otherwise, [0-9A-F]." ;;;###autoload (defun ethio-java-to-fidel-buffer nil - "Convert the Java escape sequences into corresponding Ethiopic characters." + "Convert the Java escape sequences in the buffer into Ethiopic characters." (let ((case-fold-search t) (ucode)) (goto-char (point-min)) @@ -922,7 +958,17 @@ Otherwise, [0-9A-F]." ;;;###autoload (defun ethio-find-file nil - "Transliterate file content into Ethiopic depending on filename suffix." + "Transliterate file content into Ethiopic depending on filename suffix. +If the file-name extension is \".sera\", convert from SERA to FIDEL. +If the file-name extension is \".html\", convert regions enclosed +by \"<sera>..</sera>\" from SERA to FIDEL. +If the file-name extension is \".tex\", convert fidel-tex commands +to FIDEL characters. +If the file-name extension is \".java\", convert Java escape sequences +to FIDEL characters. + +FIDEL is the Amharic alphabet; SERA (System for Ethiopic Representation +in ASCII) is the Latin representation of Ethiopic script." (cond ((string-match "\\.sera$" (buffer-file-name)) @@ -956,7 +1002,17 @@ Otherwise, [0-9A-F]." ;;;###autoload (defun ethio-write-file nil - "Transliterate Ethiopic characters in ASCII depending on the file extension." + "Transliterate Ethiopic characters to ASCII depending on the file extension. +If the file-name extension is \".sera\", convert from FIDEL to SERA. +If the file-name extension is \".html\", convert FIDEL characters to +SERA regions enclosed by \"<sera>..</sera>\". +If the file-name extension is \".tex\", convert FIDEL characters +to fidel-tex commands. +If the file-name extension is \".java\", convert FIDEL characters to +Java escape sequences. + +FIDEL is the Amharic alphabet; SERA (System for Ethiopic Representation +in ASCII) is the Latin representation of Ethiopic script." (cond ((string-match "\\.sera$" (buffer-file-name)) @@ -1062,7 +1118,7 @@ With ARG, insert that many delimiters." ;; This function is not used any more. (defun ethio-gemination nil - "Compose the character before the point with the Ethiopic gemination mark. + "Compose the character before point with the Ethiopic gemination mark. If the character is already composed, decompose it and remove the gemination mark." (interactive "*") @@ -1081,7 +1137,9 @@ mark." ;;; (robin-define-package "ethiopic-sera" - "SERA transliteration system for Ethiopic." + "SERA transliteration system for Ethiopic. +SERA (System for Ethiopic Representation in ASCII) is the Latin +representation of Ethiopic script." ("he" ?ሀ) ("hu" ?ሁ) diff --git a/lisp/language/ethiopic.el b/lisp/language/ethiopic.el index 1faba424ba2..fb1e2728436 100644 --- a/lisp/language/ethiopic.el +++ b/lisp/language/ethiopic.el @@ -27,6 +27,13 @@ ;;; Commentary: +;; Note: This file includes several codepoints outside of the Unicode +;; 0..#x10FFFF range, which are characters that were not unified into +;; Unicode. Therefore, this file is encoded in utf-8-emacs, because +;; UTF-8 cannot encode such codepoints. We include these codepoints +;; literally in the file to have them displayed by suitable fonts, +;; which makes maintenance easier. + ;;; Code: (define-ccl-program ccl-encode-ethio-font diff --git a/lisp/language/ind-util.el b/lisp/language/ind-util.el index 27facaa858f..447ca0c20cc 100644 --- a/lisp/language/ind-util.el +++ b/lisp/language/ind-util.el @@ -27,11 +27,18 @@ ;; Finally, this program provides the compatibility support with ;; old implementation of Devanagari script. +;; Note: This file includes several codepoints outside of the Unicode +;; 0..#x10FFFF range, which are characters that were not unified into +;; Unicode. Therefore, this file is encoded in utf-8-emacs, because +;; UTF-8 cannot encode such codepoints. We include these codepoints +;; literally in the file to have them displayed by suitable fonts, +;; which makes maintenance easier. + ;;; Code: ;;; Transliteration -;; The followings provide the various transliteration schemes (such as +;; The following provides the various transliteration schemes (such as ;; ITRANS, kyoto-harvard, and Aiba) of Indian scripts. They are also ;; used in quail/indian.el for typing Indian script in Emacs. @@ -638,7 +645,7 @@ ;;; IS 13194 utilities -;; The followings provide conversion between IS 13194 (ISCII) and UCS. +;; The following provides conversion between IS 13194 (ISCII) and UCS. (dlet ;;Unicode vs IS13194 ;; only Devanagari is supported now. diff --git a/lisp/language/tibet-util.el b/lisp/language/tibet-util.el index e7cb289b65f..0f09c48d6d6 100644 --- a/lisp/language/tibet-util.el +++ b/lisp/language/tibet-util.el @@ -32,6 +32,13 @@ ;;; Commentary: +;; Note: This file includes several codepoints outside of the Unicode +;; 0..#x10FFFF range, which are characters that were not unified into +;; Unicode. Therefore, this file is encoded in utf-8-emacs, because +;; UTF-8 cannot encode such codepoints. We include these codepoints +;; literally in the file to have them displayed by suitable fonts, +;; which makes maintenance easier. + ;;; Code: (defconst tibetan-obsolete-glyphs diff --git a/lisp/language/tibetan.el b/lisp/language/tibetan.el index 0262798bb27..81210457897 100644 --- a/lisp/language/tibetan.el +++ b/lisp/language/tibetan.el @@ -34,6 +34,13 @@ ;;; Commentary: +;; Note: This file includes several codepoints outside of the Unicode +;; 0..#x10FFFF range, which are characters that were not unified into +;; Unicode. Therefore, this file is encoded in utf-8-emacs, because +;; UTF-8 cannot encode such codepoints. We include these codepoints +;; literally in the file to have them displayed by suitable fonts, +;; which makes maintenance easier. + ;;; Code: ;;; Tibetan Character set. diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index c754e723542..3f36cfbba58 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -10010,7 +10010,7 @@ If ERC is already connected to HOST:PORT, simply /join CHANNEL. Otherwise, connect to HOST:PORT as USER and /join CHANNEL. (fn HOST PORT CHANNEL USER PASSWORD)") -(register-definition-prefixes "erc" '("define-erc-module" "erc-")) +(register-definition-prefixes "erc" '("erc-")) ;;; Generated autoloads from erc/erc-autoaway.el @@ -10033,6 +10033,11 @@ Otherwise, connect to HOST:PORT as USER and /join CHANNEL. (register-definition-prefixes "erc-capab" '("erc-capab-identify-")) +;;; Generated autoloads from erc/erc-common.el + +(register-definition-prefixes "erc-common" '("define-erc-module" "erc-")) + + ;;; Generated autoloads from erc/erc-compat.el (register-definition-prefixes "erc-compat" '("erc-")) @@ -10931,6 +10936,23 @@ Edit the hotlist of directory servers in a specialized buffer." t) (register-definition-prefixes "eudcb-bbdb" '("eudc-bbdb-")) +;;; Generated autoloads from net/eudcb-ecomplete.el + +(autoload 'eudc-ecomplete-query-internal "eudcb-ecomplete" "\ +Query `ecomplete' with QUERY. +QUERY is a list of cons cells (ATTR . VALUE). Since `ecomplete' +does not provide attributes in the usual sense, the +back-end-specific attribute names in +`eudc-ecomplete-attributes-translation-alist' are used as the +KEY (that is, the \"type\" of match) when looking for matches in +`ecomplete-database'. + +RETURN-ATTRS is ignored. + +(fn QUERY &optional RETURN-ATTRS)") +(register-definition-prefixes "eudcb-ecomplete" '("eudc-ecomplete-attributes-translation-alist")) + + ;;; Generated autoloads from net/eudcb-ldap.el (register-definition-prefixes "eudcb-ldap" '("eudc-")) @@ -10946,6 +10968,26 @@ Edit the hotlist of directory servers in a specialized buffer." t) (register-definition-prefixes "eudcb-macos-contacts" '("eudc-macos-contacts-")) +;;; Generated autoloads from net/eudcb-mailabbrev.el + +(autoload 'eudc-mailabbrev-query-internal "eudcb-mailabbrev" "\ +Query `mailabbrev' with QUERY. +QUERY is a list of cons cells (ATTR . VALUE). Since `mailabbrev' +does not provide attributes in the usual sense, only the email, +name, and firstname attributes in the QUERY are considered, and +their values are matched against the alias names in the mailrc +file. When a mailrc alias is a distribution list, that is it +expands to more that one email address, the individual recipient +specifications are formatted using `eudc-rfc5322-make-address', +and returned as a comma-separated list in the email address +attribute. + +RETURN-ATTRS is a list of attributes to return, defaulting to +`eudc-default-return-attributes'. + +(fn QUERY &optional RETURN-ATTRS)") + + ;;; Generated autoloads from emacs-lisp/ewoc.el (autoload 'ewoc-create "ewoc" "\ @@ -11280,7 +11322,7 @@ See `text-scale-increase' for more details. (define-key ctl-x-map [(control ?0)] 'text-scale-adjust) (autoload 'text-scale-adjust "face-remap" "\ Adjust the font size in the current buffer by INC steps. -INC may be passed as a numeric prefix argument. +Interactively, INC is the prefix numeric argument, and defaults to 1. The actual adjustment made depends on the final component of the keybinding used to invoke the command, with all modifiers removed: @@ -11290,13 +11332,14 @@ keybinding used to invoke the command, with all modifiers removed: \\`0' Reset the font size to the global default After adjusting, continue to read input events and further adjust -the font size as long as the input event read -(with all modifiers removed) is one of the above characters. +the font size as long as the input event (with all modifiers removed) +is one of the above characters. -Each step scales the height of the default face by the variable -`text-scale-mode-step' (a negative number of steps decreases the -height by the same amount). As a special case, an argument of 0 -will remove any scaling currently active. +Each step scales the height of the default face by the factor that +is the value of `text-scale-mode-step' (a negative number of steps +decreases the height by that factor). As a special case, an argument +of 0 will remove any scaling currently active, thus resetting the +font size to the original value. This command is a special-purpose wrapper around the `text-scale-increase' command which makes repetition convenient @@ -11322,19 +11365,22 @@ Adjust the height of the default face by the scale in the pinch event EVENT. (define-key ctl-x-map [(control meta ?-)] 'global-text-scale-adjust) (define-key ctl-x-map [(control meta ?0)] 'global-text-scale-adjust) (autoload 'global-text-scale-adjust "face-remap" "\ -Globally adjust the font size by INCREMENT. +Change (a.k.a. \"adjust\") the font size of all faces by INCREMENT. -Interactively, INCREMENT may be passed as a numeric prefix argument. +Interactively, INCREMENT is the prefix numeric argument, and defaults +to 1. Positive values of INCREMENT increase the font size, negative +values decrease it. -The adjustment made depends on the final component of the key binding -used to invoke the command, with all modifiers removed: +When you invoke this command, it performs the initial change of the +font size, and after that allows further changes by typing one of the +following keys immediately after invoking the command: \\`+', \\`=' Globally increase the height of the default face \\`-' Globally decrease the height of the default face \\`0' Globally reset the height of the default face -After adjusting, further adjust the font size as long as the key, -with all modifiers removed, is one of the above characters. +(The change of the font size produced by these keys depends on the +final component of the key sequence, with all modifiers removed.) Buffer-local face adjustments have higher priority than global face adjustments. @@ -21217,6 +21263,9 @@ a greeting from the server. :nowait, if non-nil, says the connection should be made asynchronously, if possible. +:noquery - when exiting Emacs and the network process is running, +don't query the user if it's non-nil. + :shell-command is a `format-spec' string that can be used if :type is `shell'. It has two specs, %s for host and %p for port number. Example: \"ssh gateway nc %s %p\". @@ -23064,6 +23113,81 @@ Location of the file used to speed up activation of packages at startup." :type (register-definition-prefixes "package" '("bad-signature" "define-package" "describe-package-1" "package-")) +;;; Generated autoloads from emacs-lisp/package-vc.el + +(defvar package-vc-selected-packages 'nil "\ +List of packages that must be installed. +Each member of the list is of the form (NAME . SPEC), where NAME +is a symbol designating the package and SPEC is one of: + +- nil, if any package version can be installed; +- a version string, if that specific revision is to be installed; +- a property list of the form described in + `package-vc-archive-spec-alist', giving a package + specification. + +This user option differs from `package-selected-packages' in that +it is meant to be specified manually. You can also use the +function `package-vc-selected-packages' to apply the changes.") +(custom-autoload 'package-vc-selected-packages "package-vc" nil) +(autoload 'package-vc-install "package-vc" "\ +Fetch a package NAME-OR-URL and set it up for using with Emacs. +If NAME-OR-URL is a URL, download the package from the repository +at that URL; the function will try to guess the name of the package +from the URL. Otherwise NAME-OR-URL should be a symbol whose name +is the package name, and the URL for the package will be taken from +the package's metadata. +By default, this function installs the last version of the package +available from its repository, but if REV is given and non-nil, it +specifies the revision to install. If REV has the special value +`:last-release' (interactively, the prefix argument), that stands +for the last released version of the package. +When calling from Lisp, optional argument NAME overrides the package +name as deduced from NAME-OR-URL. +Optional argument BACKEND specifies the VC backend to use for cloning +the package's repository; this is only possible if NAME-OR-URL is a URL, +a string. If BACKEND is omitted or nil, the function +uses `package-vc--guess-backend' to guess the backend. + +(fn NAME-OR-URL &optional NAME REV BACKEND)" t) +(autoload 'package-vc-checkout "package-vc" "\ +Clone the sources for PKG-DESC into DIRECTORY and visit that directory. +Unlike `package-vc-install', this does not yet set up the package +for use with Emacs; use `package-vc-link-directory' for setting +the package up after this function finishes. +Optional argument REV means to clone a specific version of the +package; it defaults to the last version available from the +package's repository. If REV has the special value +`:last-release' (interactively, the prefix argument), that stands +for the last released version of the package. + +(fn PKG-DESC DIRECTORY &optional REV)" t) +(autoload 'package-vc-install-from-checkout "package-vc" "\ +Set up the package NAME in DIR by linking it into the ELPA directory. +Interactively, prompt the user for DIR, which should be a directory +under version control, typically one created by `package-vc-checkout'. +If invoked interactively with a prefix argument, prompt the user +for the NAME of the package to set up. Otherwise infer the package +name from the base name of DIR. + +(fn DIR NAME)" t) +(autoload 'package-vc-refresh "package-vc" "\ +Refresh the installation for package given by PKG-DESC. +Interactively, prompt for the name of the package to refresh. + +(fn PKG-DESC)" t) +(autoload 'package-vc-prepare-patch "package-vc" "\ +Send patch for REVISIONS to maintainer of the package PKG using SUBJECT. +SUBJECT and REVISIONS are passed on to `vc-prepare-patch', which see. +PKG must be a package description. +Interactively, prompt for PKG, SUBJECT, and REVISIONS. However, +if the current buffer has marked commit log entries, REVISIONS +are the tags of the marked entries, see `log-view-get-marked'. + +(fn PKG SUBJECT REVISIONS)" t) +(register-definition-prefixes "package-vc" '("package-vc-")) + + ;;; Generated autoloads from emacs-lisp/package-x.el (autoload 'package-upload-file "package-x" "\ @@ -24616,7 +24740,7 @@ Open profile FILENAME. ;;; Generated autoloads from progmodes/project.el -(push (purecopy '(project 0 8 2)) package--builtin-versions) +(push (purecopy '(project 0 8 3)) package--builtin-versions) (autoload 'project-current "project" "\ Return the project instance in DIRECTORY, defaulting to `default-directory'. @@ -26744,6 +26868,8 @@ Return ROT13 encryption of STRING. (fn STRING)") (autoload 'rot13-region "rot13" "\ ROT13 encrypt the region between START and END in current buffer. +If invoked interactively and the buffer is read-only, a message +will be printed instead. (fn START END)" t) (autoload 'rot13-other-window "rot13" "\ diff --git a/lisp/leim/quail/ethiopic.el b/lisp/leim/quail/ethiopic.el index c8753effe0a..df4bf596cb6 100644 --- a/lisp/leim/quail/ethiopic.el +++ b/lisp/leim/quail/ethiopic.el @@ -26,6 +26,13 @@ ;;; Commentary: +;; Note: This file includes several codepoints outside of the Unicode +;; 0..#x10FFFF range, which are characters that were not unified into +;; Unicode. Therefore, this file is encoded in utf-8-emacs, because +;; UTF-8 cannot encode such codepoints. We include these codepoints +;; literally in the file to have them displayed by suitable fonts, +;; which makes maintenance easier. + ;;; Code: (require 'quail) diff --git a/lisp/leim/quail/indian.el b/lisp/leim/quail/indian.el index 31a34bc1de2..8fe81a22173 100644 --- a/lisp/leim/quail/indian.el +++ b/lisp/leim/quail/indian.el @@ -371,9 +371,9 @@ Full key sequences are listed below:") ;;; Tamil phonetic input method ;;; -;; Define the input method straightaway. +;; Define the input method straight away. (quail-define-package "tamil-phonetic" "Tamil" "ழ" t - "Customisable Tamil phonetic input method. + "Customizable Tamil phonetic input method. To change the translation rules of the input method, customize `tamil-translation-rules'. diff --git a/lisp/leim/quail/japanese.el b/lisp/leim/quail/japanese.el index df080fc0e87..fb8b9e61665 100644 --- a/lisp/leim/quail/japanese.el +++ b/lisp/leim/quail/japanese.el @@ -359,7 +359,7 @@ input method. The input method `japanese-zenkaku' is used to enter full width JISX0208 characters corresponding to typed ASCII characters. -List of the all key sequences for Roman-Kana transliteration is shown +List of all the key sequences for Roman-Kana transliteration is shown at the tail. :: Kana-Kanji conversion :: diff --git a/lisp/leim/quail/misc-lang.el b/lisp/leim/quail/misc-lang.el index 73287ee7842..e9e11ac6799 100644 --- a/lisp/leim/quail/misc-lang.el +++ b/lisp/leim/quail/misc-lang.el @@ -1526,7 +1526,7 @@ (quail-define-package "gothic" "Gothic" "𐌰" nil - "Input methid for the ancient Gothic script." + "Input method for the ancient Gothic script." nil t t t t nil nil nil nil nil t) (quail-define-rules diff --git a/lisp/leim/quail/tibetan.el b/lisp/leim/quail/tibetan.el index ca44f7022d2..7f0848d04bd 100644 --- a/lisp/leim/quail/tibetan.el +++ b/lisp/leim/quail/tibetan.el @@ -33,6 +33,13 @@ ;;; Commentary: +;; Note: This file includes several codepoints outside of the Unicode +;; 0..#x10FFFF range, which are characters that were not unified into +;; Unicode. Therefore, this file is encoded in utf-8-emacs, because +;; UTF-8 cannot encode such codepoints. We include these codepoints +;; literally in the file to have them displayed by suitable fonts, +;; which makes maintenance easier. + ;;; Code: (require 'quail) diff --git a/lisp/mail/feedmail.el b/lisp/mail/feedmail.el index 2ae916e3ac1..97d20cca151 100644 --- a/lisp/mail/feedmail.el +++ b/lisp/mail/feedmail.el @@ -131,17 +131,13 @@ ;; feedmail-send-it. Hers's the best way to use the stuff in this ;; file: ;; -;; Save this file as feedmail.el somewhere on your elisp loadpath; -;; byte-compile it. Put the following lines in your init file: +;; Put the following lines in your init file: ;; ;; (setq send-mail-function 'feedmail-send-it) -;; (autoload 'feedmail-send-it "feedmail") ;; ;; If you plan to use the queue stuff, also use this: ;; ;; (setq feedmail-enable-queue t) -;; (autoload 'feedmail-run-the-queue "feedmail") -;; (autoload 'feedmail-run-the-queue-no-prompts "feedmail") ;; (setq auto-mode-alist (cons '("\\.fqm$" . mail-mode) auto-mode-alist)) ;; ;; though VM users might find it more comfortable to use this instead of @@ -174,11 +170,6 @@ ;; like to add the suffix ".fqm" to the list of non-saved things via the variable ;; desktop-files-not-to-save. ;; -;; If you are planning to call feedmail-queue-reminder from your .emacs or -;; something similar, you might need this: -;; -;; (autoload 'feedmail-queue-reminder "feedmail") -;; ;; If you ever use rmail-resend and queue messages, you should do this: ;; ;; (setq feedmail-queue-alternative-mail-header-separator "") @@ -2775,7 +2766,7 @@ return that value." (cond ;; nil means do nothing ((eq nil feedmail-date-generator) nil) - ;; t is the same a using the function feedmail-default-date-generator, so let it and recurse + ;; t is the same as using the function feedmail-default-date-generator, so let it and recurse ((eq t feedmail-date-generator) (let ((feedmail-date-generator (feedmail-default-date-generator maybe-file))) (feedmail-fiddle-date maybe-file))) @@ -2831,7 +2822,7 @@ probably not appropriate for you." (cond ;; nil means do nothing ((eq nil feedmail-message-id-generator) nil) - ;; t is the same a using the function feedmail-default-message-id-generator, so let it and recurse + ;; t is the same as using the function feedmail-default-message-id-generator, so let it and recurse ((eq t feedmail-message-id-generator) (let ((feedmail-message-id-generator (feedmail-default-message-id-generator maybe-file))) (feedmail-fiddle-message-id maybe-file))) @@ -2873,7 +2864,7 @@ probably not appropriate for you." (cond ;; nil means do nothing ((eq nil feedmail-x-mailer-line) nil) - ;; t is the same a using the function feedmail-default-x-mailer-generator, so let it and recurse + ;; t is the same as using the function feedmail-default-x-mailer-generator, so let it and recurse ((eq t feedmail-x-mailer-line) (let ((feedmail-x-mailer-line (feedmail-default-x-mailer-generator))) (feedmail-fiddle-x-mailer))) diff --git a/lisp/mail/ietf-drums-date.el b/lisp/mail/ietf-drums-date.el index ddef7f11b66..034854dce5a 100644 --- a/lisp/mail/ietf-drums-date.el +++ b/lisp/mail/ietf-drums-date.el @@ -126,7 +126,7 @@ treat them as whitespace (per RFC822)." (defun ietf-drums-parse-date-string (time-string &optional error no-822) "Parse an RFC5322 or RFC822 date, passed as TIME-STRING. The optional ERROR parameter causes syntax errors to be flagged -by signalling an instance of the date-parse-error condition. The +by signaling an instance of the date-parse-error condition. The optional NO-822 parameter disables the more lax RFC822 syntax, which is permitted by default. @@ -162,7 +162,7 @@ DST is returned as -1)." (time (list nil nil nil nil nil nil nil -1 nil))) (cl-labels ((set-matched-slot (slot index token) ;; Assign a slot value from match data if index is - ;; non-nil, else from token, signalling an error if + ;; non-nil, else from token, signaling an error if ;; enabled and it's out of range. (let ((value (if index (cl-parse-integer (match-string index token)) diff --git a/lisp/mail/mail-hist.el b/lisp/mail/mail-hist.el index a13f9de1740..9fb7b36e985 100644 --- a/lisp/mail/mail-hist.el +++ b/lisp/mail/mail-hist.el @@ -1,6 +1,6 @@ ;;; mail-hist.el --- headers and message body history for outgoing mail -*- lexical-binding: t; -*- -;; Copyright (C) 1994, 2001-2022 Free Software Foundation, Inc. +;; Copyright (C) 1994-2022 Free Software Foundation, Inc. ;; Author: Karl Fogel <kfogel@red-bean.com> ;; Created: March, 1994 @@ -24,21 +24,15 @@ ;;; Commentary: -;; Thanks to Jim Blandy for mentioning ring.el. It saved a lot of -;; time. -;; -;; To use this package, put it in a directory in your load-path, and -;; put this in your init file: +;; To use this package, add this to your init file: ;; -;; (load "mail-hist" nil t) +;; (require 'mail-hist) ;; -;; Or you could do it with autoloads and hooks in your .emacs: +;; Or you could do it with hooks in your .emacs: ;; -;; (add-hook 'mail-mode-hook 'mail-hist-define-keys) -;; (add-hook 'mail-send-hook 'mail-hist-put-headers-into-history) -;; (add-hook 'vm-mail-mode-hook 'mail-hist-define-keys) ;or rmail, etc -;; (autoload 'mail-hist-define-keys "mail-hist") -;; (autoload 'mail-hist-put-headers-into-history "mail-hist") +;; (add-hook 'mail-mode-hook 'mail-hist-define-keys) +;; (add-hook 'mail-send-hook 'mail-hist-put-headers-into-history) +;; (add-hook 'vm-mail-mode-hook 'mail-hist-define-keys) ;or rmail, etc ;; ;; Once it's installed, use M-p and M-n from mail headers to recover ;; previous/next contents in the history for that header, or, in the @@ -51,6 +45,9 @@ ;; point, so that you can mix the histories of different messages ;; easily. This might be confusing at times, but there should be no ;; problems that undo can't handle. +;; +;; Thanks to Jim Blandy for mentioning ring.el. It saved a lot of +;; time. ;;; Code: (require 'ring) diff --git a/lisp/mail/reporter.el b/lisp/mail/reporter.el index 324165a8ffe..231fa69baa2 100644 --- a/lisp/mail/reporter.el +++ b/lisp/mail/reporter.el @@ -357,7 +357,7 @@ mail-sending package is used for editing and sending the message." (goto-char final-resting-place)) (set-marker final-resting-place nil)) - ;; save initial text and set up the `no-empty-submission' hook. + ;; save initial text and set up the no empty submission hook. ;; This only works for mailers that support a pre-send hook, and ;; for which the paradigm has a non-nil value for the `hookvar' ;; key in its agent (i.e. sendmail.el's mail-send-hook). diff --git a/lisp/mail/rfc6068.el b/lisp/mail/rfc6068.el index 54035b66981..4863f3582c3 100644 --- a/lisp/mail/rfc6068.el +++ b/lisp/mail/rfc6068.el @@ -43,9 +43,9 @@ string instead of decoding as utf-8." (defun rfc6068-parse-mailto-url (mailto-url) "Parse MAILTO-URL, and return an alist of header-name, header-value pairs. -MAILTO-URL should be a RFC 6068 (mailto) compliant url. A cons cell w/ a +MAILTO-URL should be a RFC 6068 (mailto) compliant url. A cons cell with a key of `Body' is a special case and is considered a header for this purpose. -The returned alist is intended for use w/ the `compose-mail' interface. +The returned alist is intended for use with the `compose-mail' interface. Note: make sure MAILTO-URL has been \"unhtmlized\" (e.g., & -> &), before calling this function." (let ((case-fold-search t) diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index f095d5e9c08..2421b283e6b 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el @@ -1751,6 +1751,7 @@ not be a new one). It returns non-nil if it got any new messages." (spam-filter-p (and (featurep 'rmail-spam-filter) rmail-use-spam-filter)) (blurb "") + (mod-p (buffer-modified-p)) result success suffix) (narrow-to-region (point) (point)) ;; Read in the contents of the inbox files, renaming them as @@ -1766,10 +1767,11 @@ not be a new one). It returns non-nil if it got any new messages." (rmail-insert-inbox-text files nil) (setq delete-files (rmail-insert-inbox-text files t)))) ;; If there was no new mail, or we aborted before actually - ;; trying to get any, mark buffer unmodified. Otherwise the - ;; buffer is correctly marked modified and the file locked - ;; until we save out the new mail. - (if (= (point-min) (point-max)) + ;; trying to get any, mark buffer unmodified, unless it was + ;; modified originally. Otherwise the buffer is correctly + ;; marked modified and the file locked until we save out the + ;; new mail. + (if (and (null mod-p) (= (point-min) (point-max))) (set-buffer-modified-p nil))) ;; Scan the new text and convert each message to ;; Rmail/mbox format. @@ -2597,7 +2599,7 @@ is greater than zero; otherwise, show it in full." "Handle a \"Mail-Followup-To\" header field with an unknown mailing list. Ask the user whether to add that list name to `mail-mailing-lists'." ;; FIXME s-r not needed? Use rmail-get-header? - ;; We have not narrowed to the headers at ths point? + ;; We have not narrowed to the headers at this point? (save-restriction (let ((mail-followup-to (mail-fetch-field "mail-followup-to" nil t))) (when mail-followup-to diff --git a/lisp/mail/rmailsum.el b/lisp/mail/rmailsum.el index 0144a34e5e7..b30c32aaffd 100644 --- a/lisp/mail/rmailsum.el +++ b/lisp/mail/rmailsum.el @@ -50,23 +50,40 @@ Setting this option to nil might speed up the generation of summaries." :type 'boolean :group 'rmail-summary) -(defcustom rmail-summary-apply-filters-consecutively nil - "If non-nil, Rmail summary commands apply filtering on top existing filtering. -When this variable is non-nil, `rmail-summary-by-*' commands work on the -current summary, and so their filtering can be stacked one on top of another. -This allows gradual narrowing of the selection of the messages." +(defcustom rmail-summary-progressively-narrow nil + "Non-nil means progressively narrow the set of messages produced by summary. +This allows to apply the summary criteria on top one another, +thus progressively narrowing the selection of the messages produced +by each summary criteria. +For example, applying `rmail-summary-by-senders' on top +of `rmail-summary-by-topic' produces a summary of messages +with the specified Subjects that were sent from specified +sending addresses. +This way, the user can apply one summary on top of another, +and keep narrowing the resulting list of messages." :type 'boolean :version "29.1" :group 'rmail-summary) (defvar rmail-summary-currently-displayed-msgs nil - "String made of `y' and `n'. -The character at position i tells wether message i is shown in the -summary or not. First character is ignored. -Used when applying `rmail-summary-by-*' commands consecutively. Filled -by `rmail-summary-fill-displayed-messages'.") + "Boolean vector that tells which messages are displayed in the summary. +First element is ignored. Used when applying rmail-summary-by-* +commands consecutively. Filled by +`rmail-summary-populate-displayed-messages'.") (put 'rmail-summary-currently-displayed-msgs 'permanent-local t) +(defvar rmail-summary-message-ids-hash-table nil + "Hash table linking Message IDs of messages with their indices.") + +(defvar rmail-summary-subjects-hash-table nil + "Hash table linking subjects with index of the first message with that subject.") + +(defvar rmail-summary-message-parents-vector nil + "Vector that holds a list of indices of parents for each message. +Message A is parent to message B if the id of A appear in the +References or In-reply-to fields of B, or if A is the first +message with the same subject as B. First element is ignored.") + (defvar rmail-summary-font-lock-keywords '(("^ *[0-9]+D.*" . font-lock-string-face) ; Deleted. ("^ *[0-9]+-.*" . font-lock-type-face) ; Unread. @@ -284,33 +301,85 @@ by `rmail-summary-fill-displayed-messages'.") (defun rmail-update-summary (&rest _) (apply (car rmail-summary-redo) (cdr rmail-summary-redo))) -(defun rmail-summary-fill-displayed-messages () - "Fill the rmail-summary-currently-displayed-msgs string." +(defun rmail-summary-populate-displayed-messages () + "Populate the `rmail-summary-currently-displayed-msgs' vector." (with-current-buffer rmail-buffer - (with-current-buffer rmail-summary-buffer - (setq rmail-summary-currently-displayed-msgs - (make-string (1+ rmail-total-messages) ?n)) - (goto-char (point-min)) - (while (not (eobp)) - (aset rmail-summary-currently-displayed-msgs - (string-to-number (thing-at-point 'line)) - ?y) - (forward-line 1))))) - -(defun rmail-summary-negate () - "Toggle display of messages that match the summary and those which do not." + (let ((totmsgs rmail-total-messages)) + (with-current-buffer rmail-summary-buffer + (setq rmail-summary-currently-displayed-msgs + (make-bool-vector (1+ totmsgs) nil)) + (goto-char (point-min)) + (while (not (eobp)) + (aset rmail-summary-currently-displayed-msgs + (string-to-number (thing-at-point 'line)) + t) + (forward-line 1)))))) + +(defun rmail-summary-fill-message-ids-hash-table () + "Fill `rmail-summary-message-ids-hash-table'." + (with-current-buffer rmail-buffer + (setq rmail-summary-message-ids-hash-table (make-hash-table :test 'equal :size 1024)) + (let ((msgnum 1)) + (while (<= msgnum rmail-total-messages) + (let ((id (rmail-get-header "Message-ID" msgnum))) + (puthash id (cons (cons id msgnum) (gethash id rmail-summary-message-ids-hash-table)) + rmail-summary-message-ids-hash-table)) + (setq msgnum (1+ msgnum)))))) + +(defun rmail-summary--split-header-field (name &optional msgnum) + (let ((header (rmail-get-header name msgnum))) + (if header + (split-string header "[ \f\t\n\r\v,;]+")))) + +(defun rmail-summary-fill-message-parents-vector () + "Fill `rmail-summary-message-parents-vector'." + (with-current-buffer rmail-buffer + (rmail-summary-fill-message-ids-hash-table) + (setq rmail-summary-subjects-hash-table + (make-hash-table :test 'equal :size 1024)) + (setq rmail-summary-message-parents-vector + (make-vector (1+ rmail-total-messages) nil)) + (let ((msgnum 1)) + (while (<= msgnum rmail-total-messages) + (let* ((parents nil) + (subject (rmail-simplified-subject msgnum)) + (subj-cell (gethash subject rmail-summary-subjects-hash-table)) + (subj-par (assoc subject subj-cell)) + (refs (rmail-summary--split-header-field "References" msgnum)) + (reply-to (rmail-summary--split-header-field "In-reply-to" + msgnum))) + (if subj-par + (setq parents (cons (cdr subj-par) parents)) + (puthash subject (cons (cons subject msgnum) subj-cell) + rmail-summary-subjects-hash-table)) + (dolist (id (append refs reply-to)) + (let ((ent + (assoc id + (gethash id rmail-summary-message-ids-hash-table)))) + (if ent + (setq parents (cons (cdr ent) parents))))) + (aset rmail-summary-message-parents-vector msgnum parents) + (setq msgnum (1+ msgnum))))))) + +(defun rmail-summary-invert () + "Invert the criteria of the current summary. +That is, show the messages that are not displayed, and hide +the messages that are displayed." (interactive) - (rmail-summary-fill-displayed-messages) - (rmail-new-summary "Negate" + (rmail-summary-populate-displayed-messages) + (rmail-new-summary "Invert" '(rmail-summary-by-regexp ".*") (lambda (msg) (if - (= (aref rmail-summary-currently-displayed-msgs msg) - ?n) - (progn - (aset rmail-summary-currently-displayed-msgs msg ?y) t) - (progn - (aset rmail-summary-currently-displayed-msgs msg ?n) nil))))) + (not (aref rmail-summary-currently-displayed-msgs msg)) + (aset rmail-summary-currently-displayed-msgs msg t) + (aset rmail-summary-currently-displayed-msgs msg nil))))) + +(defun rmail-summary--exists-1 () + "Like `rmail-summary-exists', but works in both main and summary buffers." + (with-current-buffer rmail-buffer + (and rmail-summary-buffer (buffer-name rmail-summary-buffer) + rmail-summary-buffer))) ;;;###autoload (defun rmail-summary () @@ -318,6 +387,63 @@ by `rmail-summary-fill-displayed-messages'.") (interactive) (rmail-new-summary "All" '(rmail-summary) nil)) +(defun rmail-summary-direct-descendants (msgnum encountered-msgs) + "Find all direct descendants of MSGNUM, ignoring ENCOUNTERED-MSGS. +Assumes `rmail-summary-message-parents-vector' is filled. Ignores messages +already ticked in ENCOUNTERED-MSGS." + (let (desc + (msg 1)) + (while (<= msg rmail-total-messages) + (when (and + (not (aref encountered-msgs msg)) + (memq msgnum (aref rmail-summary-message-parents-vector msg))) + (setq desc (cons msg desc))) + (setq msg (1+ msg))) + desc)) + +(defun rmail-summary--walk-thread-message-recursively (msgnum encountered-msgs) + "Add parents and descendants of message MSGNUM to ENCOUNTERED-MSGS, recursively." + (unless (aref encountered-msgs msgnum) + (aset encountered-msgs msgnum t) + (let ((walk-thread-msg + (lambda (msg) + (rmail-summary--walk-thread-message-recursively + msg encountered-msgs)))) + (mapc walk-thread-msg + (aref rmail-summary-message-parents-vector msgnum)) + (mapc walk-thread-msg + (rmail-summary-direct-descendants msgnum encountered-msgs))))) + +;;;###autoload +(defun rmail-summary-by-thread (&optional msgnum) + "Display a summary of messages in the same discussion thread as MSGNUM. +Interactively, prompt for MSGNUM, defaulting to the current message. +Threads are based on the \"Subject\", \"References\" and \"In-reply-to\" +headers of the messages." + (interactive + (let* ((msg rmail-current-message) + (prompt (concat "Show thread containing message number"))) + (list (read-number prompt msg)))) + (with-current-buffer rmail-buffer + (unless msgnum + (setq msgnum rmail-current-message)) + (unless (and rmail-summary-message-parents-vector + (= (length rmail-summary-message-parents-vector) + (1+ rmail-total-messages))) + (rmail-summary-fill-message-parents-vector)) + (let ((enc-msgs (make-bool-vector (1+ rmail-total-messages) nil))) + (rmail-summary--walk-thread-message-recursively msgnum enc-msgs) + (rmail-new-summary (format "thread containing message %d" msgnum) + (list 'rmail-summary-by-thread msgnum) + (if (and rmail-summary-progressively-narrow + (rmail-summary--exists-1)) + (lambda (msg _msgnum) + (and (aref rmail-summary-currently-displayed-msgs msg) + (aref enc-msgs msg))) + (lambda (msg _msgnum) + (aref enc-msgs msg))) + msgnum)))) + ;;;###autoload (defun rmail-summary-by-labels (labels) "Display a summary of all messages with one or more LABELS. @@ -327,14 +453,15 @@ LABELS should be a string containing the desired labels, separated by commas." (setq labels (or rmail-last-multi-labels (error "No label specified")))) (setq rmail-last-multi-labels labels) - (if rmail-summary-apply-filters-consecutively - (rmail-summary-fill-displayed-messages)) + (if (and rmail-summary-progressively-narrow + (rmail-summary--exists-1)) + (rmail-summary-populate-displayed-messages)) (rmail-new-summary (concat "labels " labels) (list 'rmail-summary-by-labels labels) - (if rmail-summary-apply-filters-consecutively + (if (and rmail-summary-progressively-narrow + (rmail-summary--exists-1)) (lambda (msg l) - (and (= (aref rmail-summary-currently-displayed-msgs msg) - ?y) + (and (aref rmail-summary-currently-displayed-msgs msg) (rmail-message-labels-p msg l))) 'rmail-message-labels-p) (concat " \\(" @@ -349,15 +476,16 @@ but if PRIMARY-ONLY is non-nil (prefix arg given), only look in the To and From fields. RECIPIENTS is a regular expression." (interactive "sRecipients to summarize by: \nP") - (if rmail-summary-apply-filters-consecutively - (rmail-summary-fill-displayed-messages)) + (if (and rmail-summary-progressively-narrow + (rmail-summary--exists-1)) + (rmail-summary-populate-displayed-messages)) (rmail-new-summary (concat "recipients " recipients) (list 'rmail-summary-by-recipients recipients primary-only) - (if rmail-summary-apply-filters-consecutively + (if (and rmail-summary-progressively-narrow + (rmail-summary--exists-1)) (lambda (msg r &optional po) - (and (= (aref rmail-summary-currently-displayed-msgs msg) - ?y) + (and (aref rmail-summary-currently-displayed-msgs msg) (rmail-message-recipients-p msg r po))) 'rmail-message-recipients-p) recipients primary-only)) @@ -388,14 +516,15 @@ Emacs will list the message in the summary." (setq regexp (or rmail-last-regexp (error "No regexp specified")))) (setq rmail-last-regexp regexp) - (if rmail-summary-apply-filters-consecutively - (rmail-summary-fill-displayed-messages)) + (if (and rmail-summary-progressively-narrow + (rmail-summary--exists-1)) + (rmail-summary-populate-displayed-messages)) (rmail-new-summary (concat "regexp " regexp) (list 'rmail-summary-by-regexp regexp) - (if rmail-summary-apply-filters-consecutively + (if (and rmail-summary-progressively-narrow + (rmail-summary--exists-1)) (lambda (msg r) - (and (= (aref rmail-summary-currently-displayed-msgs msg) - ?y) + (and (aref rmail-summary-currently-displayed-msgs msg) (rmail-message-regexp-p msg r))) 'rmail-message-regexp-p) regexp)) @@ -443,15 +572,16 @@ SUBJECT is a regular expression." (if subject ", default current subject" "") "): "))) (list (read-string prompt nil nil subject) current-prefix-arg))) - (if rmail-summary-apply-filters-consecutively - (rmail-summary-fill-displayed-messages)) + (if (and rmail-summary-progressively-narrow + (rmail-summary--exists-1)) + (rmail-summary-populate-displayed-messages)) (rmail-new-summary (concat "about " subject) (list 'rmail-summary-by-topic subject whole-message) - (if rmail-summary-apply-filters-consecutively + (if (and rmail-summary-progressively-narrow + (rmail-summary--exists-1)) (lambda (msg s &optional wm) - (and (= (aref rmail-summary-currently-displayed-msgs msg) - ?y) + (and (aref rmail-summary-currently-displayed-msgs msg) (rmail-message-subject-p msg s wm))) 'rmail-message-subject-p) subject whole-message)) @@ -477,15 +607,16 @@ sender of the current message." (if sender ", default this message's sender" "") "): "))) (list (read-string prompt nil nil sender)))) - (if rmail-summary-apply-filters-consecutively - (rmail-summary-fill-displayed-messages)) + (if (and rmail-summary-progressively-narrow + (rmail-summary--exists-1)) + (rmail-summary-populate-displayed-messages)) (rmail-new-summary (concat "senders " senders) (list 'rmail-summary-by-senders senders) - (if rmail-summary-apply-filters-consecutively + (if (and rmail-summary-progressively-narrow + (rmail-summary--exists-1)) (lambda (msg s) - (and (= (aref rmail-summary-currently-displayed-msgs msg) - ?y) + (and (aref rmail-summary-currently-displayed-msgs msg) (rmail-message-senders-p msg s))) 'rmail-message-senders-p) senders)) diff --git a/lisp/mail/supercite.el b/lisp/mail/supercite.el index 98f46a3af55..558785de149 100644 --- a/lisp/mail/supercite.el +++ b/lisp/mail/supercite.el @@ -1350,7 +1350,7 @@ buffer." nesting))) (defun sc-add-citation-level () - "Add a citation level for nested citation style w/ coercion." + "Add a citation level for nested citation style with coercion." (let* ((nesting (sc-guess-nesting)) (citation (make-string (1+ (length nesting)) (string-to-char sc-citation-delimiter))) diff --git a/lisp/man.el b/lisp/man.el index 6c50f017e39..3802362da09 100644 --- a/lisp/man.el +++ b/lisp/man.el @@ -331,7 +331,7 @@ This regexp should not start with a `^' character.") ;; This used to have leading space [ \t]*, but was removed because it ;; causes false page splits on an occasional NAME with leading space ;; inside a manpage. And `Man-heading-regexp' doesn't have [ \t]* anyway. -(defvar Man-first-heading-regexp "^NAME$\\|^[ \t]*No manual entry fo.*$" +(defvar Man-first-heading-regexp "^NAME$\\|^[ \t]*No manual entry for.*$" "Regular expression describing first heading on a manpage. This regular expression should start with a `^' character.") @@ -1077,13 +1077,13 @@ to auto-complete your input based on the installed manual pages." ;; unless COLUMNS or MANWIDTH is set. This isn't a problem on ;; a tty. man(1) says: ;; MANWIDTH - ;; If $MANWIDTH is set, its value is used as the line - ;; length for which manual pages should be formatted. - ;; If it is not set, manual pages will be formatted - ;; with a line length appropriate to the current ter- - ;; minal (using an ioctl(2) if available, the value of - ;; $COLUMNS, or falling back to 80 characters if nei- - ;; ther is available). + ;; If $MANWIDTH is set, its value is used as the line + ;; length for which manual pages should be formatted. + ;; If it is not set, manual pages will be formatted + ;; with a line length appropriate to the current + ;; terminal (using an ioctl(2) if available, the value + ;; of $COLUMNS, or falling back to 80 characters if + ;; neither is available). (when (or window-system (not (or (getenv "MANWIDTH") (getenv "COLUMNS")))) ;; Since the page buffer is displayed beforehand, diff --git a/lisp/mh-e/ChangeLog.1 b/lisp/mh-e/ChangeLog.1 index 00e52df2bbe..d6893fb9ec4 100644 --- a/lisp/mh-e/ChangeLog.1 +++ b/lisp/mh-e/ChangeLog.1 @@ -2944,7 +2944,7 @@ change fixes that. * mh-utils.el (mh-show-mode): Setup mh-show-mode to display - elipsis for truncated header fields and to skip over them quickly. + ellipsis for truncated header fields and to skip over them quickly. (mh-clean-msg-header): Make another pass over the message header fields truncating long headers. @@ -8064,7 +8064,7 @@ * mh-e.el (mh-last-msg): Add call to mh-recenter. -2002-10-26 Peter S Galbraith <psg@debia.org> +2002-10-26 Peter S Galbraith <psg@debian.org> * mh-comp.el (mh-search-addr-regexp, mh-re-search-to-cc): Remove `mh-re-search-to-cc' in favor of more generalized new function diff --git a/lisp/mh-e/ChangeLog.2 b/lisp/mh-e/ChangeLog.2 index 5f2dd299f84..fd597f0c00d 100644 --- a/lisp/mh-e/ChangeLog.2 +++ b/lisp/mh-e/ChangeLog.2 @@ -360,8 +360,8 @@ 2011-05-10 Jim Meyering <meyering@redhat.com> Fix doubled-word typos. - * mh-alias.el (mh-alias-minibuffer-confirm-address): if if -> if it - * mh-scan.el (mh-scan-destination-width): in in -> in + * mh-alias.el (mh-alias-minibuffer-confirm-address): + * mh-scan.el (mh-scan-destination-width): Fix typos. 2011-04-28 Stefan Monnier <monnier@iro.umontreal.ca> diff --git a/lisp/mh-e/mh-mime.el b/lisp/mh-e/mh-mime.el index 316463b9897..c0b42171b9d 100644 --- a/lisp/mh-e/mh-mime.el +++ b/lisp/mh-e/mh-mime.el @@ -607,8 +607,9 @@ If no part is preferred then all the parts are displayed." (defun mh-mime-maybe-display-alternatives (alternatives) "Show buttons for ALTERNATIVES. -If `mh-mime-display-alternatives-flag' is non-nil then display -buttons for alternative parts that are usually suppressed." +If `mh-display-buttons-for-alternatives-flag' is non-nil then +display buttons for alternative parts that are usually +suppressed." (when (and mh-display-buttons-for-alternatives-flag alternatives) (insert "\n----------------------------------------------------\n") (insert "Alternatives:\n") diff --git a/lisp/mh-e/mh-scan.el b/lisp/mh-e/mh-scan.el index 4b4c5942863..abbf7422b52 100644 --- a/lisp/mh-e/mh-scan.el +++ b/lisp/mh-e/mh-scan.el @@ -279,9 +279,9 @@ as in the default of ^ *[0-9]+.\\\\([bct]\\\\).....[ ]*\\\\(..................\\\\) If this regular expression is not correct, the notation hints -will not be highlighted with the face -`mh-mh-folder-sent-to-me-hint' and the sender will not be -highlighted with the face `mh-folder-sent-to-me-sender'.") +will not be highlighted with the face `mh-folder-sent-to-me-hint' +and the sender will not be highlighted with the face +`mh-folder-sent-to-me-sender'.") (defvar mh-scan-subject-regexp "^ *[0-9]+........[ ]*...................\\([Rr][Ee]\\(\\[[0-9]+\\]\\)?:\\s-*\\)*\\([^<\n]*\\)" diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 4898dfdb983..6bb0fa3ae98 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -850,7 +850,88 @@ via `set-message-function'." ;; was handled specially by this function. t)))) -(setq set-message-function 'set-minibuffer-message) +(setq set-message-function 'set-message-functions) + +(defcustom set-message-functions '(set-minibuffer-message) + "List of functions to handle display of echo-area messages. +Each function is called with one argument that is the text of a message. +If a function returns nil, a previous message string is given to the +next function in the list, and if the last function returns nil, the +last message string is displayed in the echo area. +If a function returns a string, the returned string is given to the +next function in the list, and if the last function returns a string, +it's displayed in the echo area. +If a function returns any other non-nil value, no more functions are +called from the list, and no message will be displayed in the echo area." + :type '(choice (const :tag "No special message handling" nil) + (repeat + (choice (function-item :tag "Inhibit some messages" + inhibit-message) + (function-item :tag "Accumulate messages" + set-multi-message) + (function-item :tag "Handle minibuffer" + set-minibuffer-message) + (function :tag "Custom function")))) + :version "29.1") + +(defun set-message-functions (message) + (run-hook-wrapped 'set-message-functions + (lambda (fun) + (when (stringp message) + (let ((ret (funcall fun message))) + (when ret (setq message ret)))) + nil)) + message) + +(defcustom inhibit-message-regexps nil + "List of regexps that inhibit messages by the function `inhibit-message'." + :type '(repeat regexp) + :version "29.1") + +(defun inhibit-message (message) + "Don't display MESSAGE when it matches the regexp `inhibit-message-regexps'. +This function is intended to be added to `set-message-functions'." + (or (and (consp inhibit-message-regexps) + (string-match-p (mapconcat #'identity inhibit-message-regexps "\\|") + message)) + message)) + +(defcustom multi-message-timeout 2 + "Number of seconds between messages before clearing the accumulated list." + :type 'number + :version "29.1") + +(defcustom multi-message-max 8 + "Max size of the list of accumulated messages." + :type 'number + :version "29.1") + +(defvar multi-message-separator "\n") + +(defvar multi-message-list nil) + +(defun set-multi-message (message) + "Return recent messages as one string to display in the echo area. +Note that this feature works best only when `resize-mini-windows' +is at its default value `grow-only'." + (let ((last-message (car multi-message-list))) + (unless (and last-message (equal message (aref last-message 1))) + (when last-message + (cond + ((> (float-time) (+ (aref last-message 0) multi-message-timeout)) + (setq multi-message-list nil)) + ((or + ;; `message-log-max' was nil, potential clutter. + (aref last-message 2) + ;; Remove old message that is substring of the new message + (string-prefix-p (aref last-message 1) message)) + (setq multi-message-list (cdr multi-message-list))))) + (push (vector (float-time) message (not message-log-max)) multi-message-list) + (when (> (length multi-message-list) multi-message-max) + (setf (nthcdr multi-message-max multi-message-list) nil))) + (mapconcat (lambda (m) (aref m 1)) + (reverse multi-message-list) + multi-message-separator))) (defun clear-minibuffer-message () "Clear minibuffer message. diff --git a/lisp/mpc.el b/lisp/mpc.el index 1775e7d5e72..f878c6ca291 100644 --- a/lisp/mpc.el +++ b/lisp/mpc.el @@ -447,7 +447,7 @@ which will be concatenated with proper quoting before passing them to MPD." ;;; Support for regularly updated current status information ;;;;;;;;;;;;;;; ;; Exported elements: -;; `mpc-status' holds the uptodate data. +;; `mpc-status' holds the up-to-date data. ;; `mpc-status-callbacks' holds the registered callback functions. ;; `mpc-status-refresh' forces a refresh of the data. ;; `mpc-status-stop' stops the automatic updating. diff --git a/lisp/net/browse-url.el b/lisp/net/browse-url.el index 1597f3651a5..7ac6396d31d 100644 --- a/lisp/net/browse-url.el +++ b/lisp/net/browse-url.el @@ -222,6 +222,14 @@ be used instead." (function :tag "Other function")) :version "26.1") +(defcustom browse-url-irc-function 'browse-url-irc + "Function to open an irc:// link." + :type '(choice + (function-item :tag "Emacs IRC" :value browse-url-irc) + (const :tag "None" nil) + (function :tag "Other function")) + :version "29.1") + (defcustom browse-url-button-regexp (concat "\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|gemini\\|" @@ -547,6 +555,11 @@ process), or nil (we don't know)." (function-put 'browse-url--man 'browse-url-browser-kind #'browse-url--browser-kind-man) +(defun browse-url--irc (url &rest args) + "Call `browse-url-irc-function' with URL and ARGS." + (funcall browse-url-irc-function url args)) +(function-put 'browse-url--irc 'browse-url-browser-kind 'internal) + (defun browse-url--browser (url &rest args) "Call `browse-url-browser-function' with URL and ARGS." (funcall browse-url-browser-function url args)) @@ -565,6 +578,7 @@ process), or nil (we don't know)." (defvar browse-url-default-handlers '(("\\`mailto:" . browse-url--mailto) ("\\`man:" . browse-url--man) + ("\\`irc6?s?://" . browse-url--irc) (browse-url--non-html-file-url-p . browse-url-emacs)) "Like `browse-url-handlers' but populated by Emacs and packages. @@ -1510,6 +1524,16 @@ used instead of `browse-url-new-window-flag'." (function-put 'browse-url-text-emacs 'browse-url-browser-kind 'internal) +;; --- irc --- + +;;;###autoload +(defun browse-url-irc (url &rest _) + "Call `url-irc' directly after parsing URL. +This function is a fit for options like `gnus-button-alist'." + (url-irc (url-generic-parse-url url))) + +(function-put 'browse-url-irc 'browse-url-browser-kind 'internal) + ;; --- mailto --- (autoload 'rfc6068-parse-mailto-url "rfc6068") diff --git a/lisp/net/eudc-capf.el b/lisp/net/eudc-capf.el index 92f0c80493d..e2bbd5b28b6 100644 --- a/lisp/net/eudc-capf.el +++ b/lisp/net/eudc-capf.el @@ -123,11 +123,12 @@ queried for email addresses, and the results delivered to (match-end 0))) (end (point)) (prefix (save-excursion (buffer-substring-no-properties beg end)))) - (list beg end - (completion-table-with-cache - (lambda (_) - (eudc-query-with-words (split-string prefix "[ \t]+") t)) - t)))))) + (let ((result + (eudc-query-with-words (split-string prefix "[ \t]+") t))) + (when result + (list beg end + (completion-table-with-cache + (lambda (_) result) t)))))))) (provide 'eudc-capf) ;;; eudc-capf.el ends here diff --git a/lisp/net/eudc-vars.el b/lisp/net/eudc-vars.el index bb1f9d9f0f3..450943a3f09 100644 --- a/lisp/net/eudc-vars.el +++ b/lisp/net/eudc-vars.el @@ -38,6 +38,9 @@ (defcustom eudc-server nil "The name or IP address of the directory server. +This variable is deprecated as of Emacs 29.1. Please add an +entry to `eudc-server-hotlist' instead of setting `eudc-server'. + A port number may be specified by appending a colon and a number to the name of the server. Use `localhost' if the directory server resides on your computer (BBDB backend). @@ -48,7 +51,7 @@ instead." ;; Known protocols (used in completion) ;; Not to be mistaken with `eudc-supported-protocols' -(defvar eudc-known-protocols '(bbdb ldap)) +(defvar eudc-known-protocols '(bbdb ldap ecomplete mailabbrev)) (defcustom eudc-server-hotlist nil "Directory servers to query. diff --git a/lisp/net/eudcb-ecomplete.el b/lisp/net/eudcb-ecomplete.el new file mode 100644 index 00000000000..55011d29f6c --- /dev/null +++ b/lisp/net/eudcb-ecomplete.el @@ -0,0 +1,108 @@ +;;; eudcb-ecomplete.el --- EUDC - ecomplete backend -*- lexical-binding: t -*- + +;; Copyright (C) 2022 Free Software Foundation, Inc. +;; +;; Author: Alexander Adolf +;; +;; This file is part of GNU Emacs. +;; +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. +;; +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: +;; This library provides an interface to the ecomplete package as +;; an EUDC data source. + +;;; Usage: +;; No setup is required, since there is an entry for this backend +;; in `eudc-server-hotlist' by default. +;; +;; For example, if your `ecomplete-database-file' (typically +;; ~/.emacs.d/ecompleterc) contains: +;; +;; ((mail ("larsi@gnus.org" 38154 1516109510 "Lars <larsi@ecomplete.org>"))) +;; +;; Then: +;; +;; C-x m lars C-u M-x eudc-expand-try-all RET +;; +;; should expand the email address into the To: field of the new +;; message. + +;;; Code: + +(require 'eudc) +(require 'ecomplete) +(require 'mail-parse) + +(defvar eudc-ecomplete-attributes-translation-alist + '((email . mail)) + "See `eudc-protocol-attributes-translation-alist'. +The back-end-specific attribute names are used as the \"type\" of +entry when searching, and they must hence match the types you use +in your ecompleterc database file.") + +;; hook ourselves into the EUDC framework +(eudc-protocol-set 'eudc-query-function + 'eudc-ecomplete-query-internal + 'ecomplete) +(eudc-protocol-set 'eudc-list-attributes-function + nil + 'ecomplete) +(eudc-protocol-set 'eudc-protocol-attributes-translation-alist + 'eudc-ecomplete-attributes-translation-alist + 'ecomplete) +(eudc-protocol-set 'eudc-protocol-has-default-query-attributes + nil + 'ecomplete) + +;;;###autoload +(defun eudc-ecomplete-query-internal (query &optional _return-attrs) + "Query `ecomplete' with QUERY. +QUERY is a list of cons cells (ATTR . VALUE). Since `ecomplete' +does not provide attributes in the usual sense, the +back-end-specific attribute names in +`eudc-ecomplete-attributes-translation-alist' are used as the +KEY (that is, the \"type\" of match) when looking for matches in +`ecomplete-database'. + +RETURN-ATTRS is ignored." ; FIXME: why is this being ignored? + (ecomplete-setup) + (let ((email-attr (car (eudc-translate-attribute-list '(email)))) + result) + (dolist (term query) + (let* ((attr (car term)) + (value (cdr term)) + (matches (ecomplete-get-matches attr value))) + (when matches + (dolist (match (split-string (string-trim (substring-no-properties + matches)) + "[\n\r]")) + ;; Try to decompose the email address. + (let* ((decoded (mail-header-parse-address match t)) + (name (cdr decoded)) + (email (car decoded))) + (if (and decoded (eq attr email-attr)) + ;; The email could be decomposed, push individual + ;; fields. + (push `((,attr . ,email) + ,@(when name (list (cons 'name name)))) + result) + ;; Otherwise just forward the value as-is. + (push (list (cons attr match)) result))))))) + result)) + +(eudc-register-protocol 'ecomplete) + +(provide 'eudcb-ecomplete) +;;; eudcb-ecomplete.el ends here diff --git a/lisp/net/eudcb-mailabbrev.el b/lisp/net/eudcb-mailabbrev.el new file mode 100644 index 00000000000..4a2dd9ad4a4 --- /dev/null +++ b/lisp/net/eudcb-mailabbrev.el @@ -0,0 +1,130 @@ +;;; eudcb-mailabbrev.el --- EUDC - mailabbrev backend -*- lexical-binding: t -*- + +;; Copyright (C) 2022 Free Software Foundation, Inc. +;; +;; Author: Alexander Adolf +;; +;; This file is part of GNU Emacs. +;; +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. +;; +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: +;; This library provides an interface to the mailabbrev package as +;; an EUDC data source. + +;;; Usage: +;; No setup is required, since there is an entry for this backend +;; in `eudc-server-hotlist' by default. +;; +;; For example, if your `mail-personal-alias-file' (typically +;; ~/.mailrc) contains: +;; +;; alias lars "Lars <larsi@mail-abbrev.com>" +;; +;; Then: +;; +;; C-x m lars C-u M-x eudc-expand-try-all RET +;; +;; will expand the correct email address into the To: field of the +;; new message. + +;;; Code: + +(require 'eudc) +(require 'mailabbrev) +(require 'mail-parse) + +;; hook ourselves into the EUDC framework +(eudc-protocol-set 'eudc-query-function + 'eudc-mailabbrev-query-internal + 'mailabbrev) +(eudc-protocol-set 'eudc-list-attributes-function + nil + 'mailabbrev) +(eudc-protocol-set 'eudc-protocol-attributes-translation-alist + nil + 'mailabbrev) +(eudc-protocol-set 'eudc-protocol-has-default-query-attributes + nil + 'mailabbrev) +;;;###autoload +(defun eudc-mailabbrev-query-internal (query &optional _return-attrs) + "Query `mailabbrev' with QUERY. +QUERY is a list of cons cells (ATTR . VALUE). Since `mailabbrev' +does not provide attributes in the usual sense, only the email, +name, and firstname attributes in the QUERY are considered, and +their values are matched against the alias names in the mailrc +file. When a mailrc alias is a distribution list, that is it +expands to more that one email address, the individual recipient +specifications are formatted using `eudc-rfc5322-make-address', +and returned as a comma-separated list in the email address +attribute. + +RETURN-ATTRS is a list of attributes to return, defaulting to +`eudc-default-return-attributes'." + (mail-abbrevs-setup) + (let (result) + (dolist (term query) + (let* ((attr (car term)) + (value (cdr term)) + (soft (intern-soft value mail-abbrevs)) + (raw-matches (and + (boundp soft) + (symbol-value soft)))) + (when (and raw-matches + (memq attr '(email firstname name))) + (let* ((matches (split-string raw-matches ", ")) + (num-matches (length matches))) + (if (> num-matches 1) + ;; multiple matches: distribution list + (let ((distr-str (string))) + (dolist (recipient matches) + ;; try to decompose email construct + (let* ((decoded (mail-header-parse-address recipient t)) + (name (cdr decoded)) + (email (car decoded))) + (if decoded + ;; decoding worked, push rfc5322 rendered address + (setq distr-str + (copy-sequence + (concat distr-str ", " + (eudc-rfc5322-make-address email + nil + name)))) + ;; else, just forward the value as-is + (setq distr-str + (copy-sequence + (concat distr-str ", " recipient)))))) + ;; push result, removing the leading ", " + (push (list (cons 'email (substring distr-str 2 -1))) + result)) + ;; simple case: single match + (let* ((match (car matches)) + (decoded (mail-header-parse-address match t)) + (name (cdr decoded)) + (email (car decoded))) + (if decoded + ;; decoding worked, push individual fields + (push `((email . ,email) + ,@(when name (list (cons 'name name)))) + result) + ;; else, just forward the value as-is + (push (list (cons 'email match)) result)))))))) + result)) + +(eudc-register-protocol 'mailabbrev) + +(provide 'eudcb-mailabbrev) + +;;; eudcb-mailabbrev.el ends here diff --git a/lisp/net/eww.el b/lisp/net/eww.el index 414de931c4a..3799ef96e84 100644 --- a/lisp/net/eww.el +++ b/lisp/net/eww.el @@ -1596,7 +1596,8 @@ See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.") (list :eww-form eww-form :value value :type "textarea" - :name (dom-attr dom 'name))))) + :name (dom-attr dom 'name))) + (put-text-property start (1+ start) 'shr-tab-stop t))) (defun eww-tag-input (dom) (let ((type (downcase (or (dom-attr dom 'type) "text"))) @@ -1660,7 +1661,8 @@ See URL `https://developer.mozilla.org/en-US/docs/Web/HTML/Element/Input'.") (add-face-text-property start (point) 'eww-form-select) (put-text-property start (point) 'keymap eww-select-map) (unless (= start (point)) - (put-text-property start (1+ start) 'help-echo "select field")) + (put-text-property start (1+ start) 'help-echo "select field") + (put-text-property start (1+ start) 'shr-tab-stop t)) (shr-ensure-paragraph)))) (defun eww-select-display (select) diff --git a/lisp/net/rcirc.el b/lisp/net/rcirc.el index 370f388b3e7..29957a62d04 100644 --- a/lisp/net/rcirc.el +++ b/lisp/net/rcirc.el @@ -1353,10 +1353,10 @@ inserting the new one." (if (use-region-p) (let ((beg (region-beginning))) (goto-char (region-end)) - (insert "") + (insert "\^O") (goto-char beg) (insert pre)) - (insert pre ""))) + (insert pre "\^O"))) (when (or (not (region-active-p)) (< (point) (mark))) (forward-char (length pre)))) @@ -1364,11 +1364,11 @@ inserting the new one." "Remove the closes formatting found closes to the current point." (interactive) (save-excursion - (when (and (search-backward-regexp (rx (or "" " " " " " " "")) + (when (and (search-backward-regexp (rx (or "\^B" "\^]" "\^_" "\^^" "\^Q")) rcirc-prompt-end-marker t) - (looking-at (rx (group (or "" " " " " " " "")) + (looking-at (rx (group (or "\^B" "\^]" "\^_" "\^^" "\^Q")) (*? nonl) - (group "")))) + (group "\^O")))) (replace-match "" nil nil nil 2) (replace-match "" nil nil nil 1)))) @@ -1378,7 +1378,7 @@ If REPLACE is non-nil or a prefix argument is given, any prior formatting will be replaced before the bold formatting is inserted." (interactive "P") - (rcirc-format "" replace)) + (rcirc-format "\^B" replace)) (defun rcirc-format-italic (replace) "Insert italic formatting. @@ -1386,7 +1386,7 @@ If REPLACE is non-nil or a prefix argument is given, any prior formatting will be replaced before the italic formatting is inserted." (interactive "P") - (rcirc-format " " replace)) + (rcirc-format "\^]" replace)) (defun rcirc-format-underline (replace) "Insert underlining formatting. @@ -1394,7 +1394,7 @@ If REPLACE is non-nil or a prefix argument is given, any prior formatting will be replaced before the underline formatting is inserted." (interactive "P") - (rcirc-format " " replace)) + (rcirc-format "\^_" replace)) (defun rcirc-format-strike-trough (replace) "Insert strike-trough formatting. @@ -1402,7 +1402,7 @@ If REPLACE is non-nil or a prefix argument is given, any prior formatting will be replaced before the strike-trough formatting is inserted." (interactive "P") - (rcirc-format " " replace)) + (rcirc-format "\^^" replace)) (defun rcirc-format-fixed-width (replace) "Insert fixed-width formatting. @@ -1410,7 +1410,7 @@ If REPLACE is non-nil or a prefix argument is given, any prior formatting will be replaced before the fixed width formatting is inserted." (interactive "P") - (rcirc-format "" replace)) + (rcirc-format "\^Q" replace)) (defvar-keymap rcirc-mode-map :doc "Keymap for rcirc mode." diff --git a/lisp/net/tramp-archive.el b/lisp/net/tramp-archive.el index 646ae864526..5b2af7c6b21 100644 --- a/lisp/net/tramp-archive.el +++ b/lisp/net/tramp-archive.el @@ -183,18 +183,20 @@ It must be supported by libarchive(3).") ;; The definition of `tramp-archive-file-name-regexp' contains calls ;; to `regexp-opt', which cannot be autoloaded while loading ;; loaddefs.el. So we use a macro, which is evaluated only when needed. +;; When tramp-archive.el is unloaded and reloaded, it gripes about +;; missing `tramp-archive{-compression]-suffixes'. We protect this. ;;;###autoload (progn (defmacro tramp-archive-autoload-file-name-regexp () "Regular expression matching archive file names." - `(rx + `(tramp-compat-rx bos ;; This group is used in `tramp-archive-file-name-archive'. (group (+ nonl) ;; Default suffixes ... - "." ,(cons '| tramp-archive-suffixes) + "." ,(cons '| (bound-and-true-p tramp-archive-suffixes)) ;; ... with compression. - (? "." ,(cons '| tramp-archive-compression-suffixes))) + (? "." ,(cons '| (bound-and-true-p tramp-archive-compression-suffixes)))) ;; This group is used in `tramp-archive-file-name-localname'. (group "/" (* nonl)) eos))) @@ -330,10 +332,6 @@ arguments to pass to the OPERATION." (inhibit-file-name-operation operation)) (apply operation args)))) -;; Starting with Emacs 29, `tramp-archive-file-name-handler' is -;; autoloaded. But it must still be in tramp-loaddefs.el for older -;; versions of Emacs. -;;;###autoload(autoload 'tramp-archive-file-name-handler "tramp-archive") ;;;###tramp-autoload (defun tramp-archive-file-name-handler (operation &rest args) "Invoke the file archive related OPERATION. @@ -396,30 +394,30 @@ arguments to pass to the OPERATION." (put #'tramp-archive-autoload-file-name-handler 'tramp-autoload t) ;;;###autoload -(progn (defun tramp-register-archive-file-name-handler () +(progn (defun tramp-register-archive-autoload-file-name-handler () "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))) + (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)))) -(put #'tramp-register-archive-file-name-handler 'tramp-autoload t) +(put #'tramp-register-archive-autoload-file-name-handler 'tramp-autoload t) ;;;###autoload (progn - (add-hook 'after-init-hook #'tramp-register-archive-file-name-handler) + (add-hook 'after-init-hook #'tramp-register-archive-autoload-file-name-handler) (add-hook 'tramp-archive-unload-hook (lambda () (remove-hook - 'after-init-hook #'tramp-register-archive-file-name-handler)))) + 'after-init-hook #'tramp-register-archive-autoload-file-name-handler)))) ;; In older Emacsen (prior 27.1), the autoload above does not exist. ;; So we call it again; it doesn't hurt. -(tramp-register-archive-file-name-handler) +(tramp-register-archive-autoload-file-name-handler) ;; Mark `operations' the handler is responsible for. (put #'tramp-archive-file-name-handler 'operations diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el index a1d1d284edb..252eab0f3b1 100644 --- a/lisp/net/tramp-compat.el +++ b/lisp/net/tramp-compat.el @@ -179,7 +179,7 @@ A nil value for either argument stands for the current time." (lambda (reporter &optional value _suffix) (progress-reporter-update reporter value)))) -;; `ignore-error' is new in Emacs Emacs 27.1. +;; `ignore-error' is new in Emacs 27.1. (defmacro tramp-compat-ignore-error (condition &rest body) "Execute BODY; if the error CONDITION occurs, return nil. Otherwise, return result of last form in BODY. diff --git a/lisp/net/tramp-container.el b/lisp/net/tramp-container.el index 328625b7765..7b942532267 100644 --- a/lisp/net/tramp-container.el +++ b/lisp/net/tramp-container.el @@ -163,6 +163,7 @@ see its function help for a description of the format." ("-u" "%u") ("%h") ("%l"))) + (tramp-direct-async (,tramp-default-remote-shell "-c")) (tramp-remote-shell ,tramp-default-remote-shell) (tramp-remote-shell-login ("-l")) (tramp-remote-shell-args ("-i" "-c")))) @@ -174,6 +175,7 @@ see its function help for a description of the format." ("-u" "%u") ("%h") ("%l"))) + (tramp-direct-async (,tramp-default-remote-shell "-c")) (tramp-remote-shell ,tramp-default-remote-shell) (tramp-remote-shell-login ("-l")) (tramp-remote-shell-args ("-i" "-c")))) @@ -186,6 +188,7 @@ see its function help for a description of the format." ("--") ("%l"))) (tramp-config-check tramp-kubernetes--current-context-data) + (tramp-direct-async (,tramp-default-remote-shell "-c")) (tramp-remote-shell ,tramp-default-remote-shell) (tramp-remote-shell-login ("-l")) (tramp-remote-shell-args ("-i" "-c")))) diff --git a/lisp/net/tramp-crypt.el b/lisp/net/tramp-crypt.el index 16c4049a687..09732581574 100644 --- a/lisp/net/tramp-crypt.el +++ b/lisp/net/tramp-crypt.el @@ -455,7 +455,7 @@ Otherwise, return NAME." (defun tramp-crypt-do-encrypt-or-decrypt-file (op root infile outfile) "Encrypt / decrypt file INFILE to OUTFILE according to encrypted directory ROOT. Both files must be local files. OP must be `encrypt' or `decrypt'. -If OP ist `decrypt', the basename of INFILE must be an encrypted file name. +If OP is `decrypt', the basename of INFILE must be an encrypted file name. Raise an error if this fails." (when-let ((tramp-crypt-enabled t) (dir (tramp-crypt-file-name-p root)) diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index b08bc63e8a2..e9f30bea7bf 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -278,8 +278,9 @@ pair of the form (KEY VALUE). The following KEYs are defined: * `tramp-direct-async' Whether the method supports direct asynchronous processes. - Until now, just \"ssh\"-based, \"sshfs\"-based and - \"adb\"-based methods do. + Until now, just \"ssh\"-based, \"sshfs\"-based, \"adb\"-based + and container methods do. If it is a list of strings, they + are used to construct the remote command. * `tramp-config-check' A function to be called with one argument, VEC. It should @@ -4804,7 +4805,14 @@ substitution. SPEC-LIST is a list of char/value pairs used for (command (append `("cd" ,(tramp-shell-quote-argument localname) "&&" "(" "env") - env `(,command ")")))) + env `(,command ")"))) + ;; Add remote shell if needed. + (command + (if (consp (tramp-get-method-parameter v 'tramp-direct-async)) + (append + (tramp-get-method-parameter v 'tramp-direct-async) + `(,(mapconcat #'identity command " "))) + command))) ;; Check for `tramp-sh-file-name-handler', because something ;; is different between tramp-sh.el, and tramp-adb.el or diff --git a/lisp/net/trampver.el b/lisp/net/trampver.el index 2b39add20d9..caf6750c26d 100644 --- a/lisp/net/trampver.el +++ b/lisp/net/trampver.el @@ -83,7 +83,7 @@ (unless (string-equal "ok" x) (error "%s" x))) (defun tramp-inside-emacs () - "Version string provided by INSIDE_EMACS enmvironment variable." + "Version string provided by INSIDE_EMACS environment variable." (concat (or (getenv "INSIDE_EMACS") emacs-version) ",tramp:" tramp-version)) diff --git a/lisp/nxml/nxml-mode.el b/lisp/nxml/nxml-mode.el index 9cbab295042..fb8d5322c07 100644 --- a/lisp/nxml/nxml-mode.el +++ b/lisp/nxml/nxml-mode.el @@ -195,7 +195,7 @@ This is not used directly, but only via inheritance by other faces." (defface nxml-char-ref-number '((t (:inherit nxml-ref))) "Face used for the number in character references. -This includes ths `x' in hex references." +This includes the `x' in hex references." :group 'nxml-faces) (defface nxml-char-ref-delimiter diff --git a/lisp/obsolete/vi.el b/lisp/obsolete/vi.el index 91baa4d28ef..afc6284b348 100644 --- a/lisp/obsolete/vi.el +++ b/lisp/obsolete/vi.el @@ -927,13 +927,13 @@ it is used instead of the saved one." (vi-repeat-last-find-char count)) (defun vi-backward-upto-char (count char) - "Find upto the COUNT'th CHAR backward on current line." + "Find up to the COUNT'th CHAR backward on current line." (interactive "p\nc") (setq vi-last-find-char (cons -1 (cons char t))) (vi-repeat-last-find-char count)) (defun vi-forward-upto-char (count char) - "Find upto the COUNT'th CHAR forward on current line." + "Find up to the COUNT'th CHAR forward on current line." (interactive "p\nc") (setq vi-last-find-char (cons 1 (cons char t))) (vi-repeat-last-find-char count)) diff --git a/lisp/org/ChangeLog.1 b/lisp/org/ChangeLog.1 index 836e1430dfe..1491a4645aa 100644 --- a/lisp/org/ChangeLog.1 +++ b/lisp/org/ChangeLog.1 @@ -881,7 +881,7 @@ (org-table-find-dataline, org-table-move-row) (org-table-insert-hline, org-table-kill-row): Use `org-move-to-column' with the IGNORE-INVISIBLE arg set to `t', so - that abbreviated rows don't interfer with setting the cursor back + that abbreviated rows don't interfere with setting the cursor back at the correct position. * org.el (org-agenda-prepare-buffers): Use `save-excursion' @@ -4724,7 +4724,7 @@ 2013-11-12 Michael Brand <michael.ch.brand@gmail.com> * org-table.el (org-table-eval-formula): Align the arrow pointing - to the error in a Calc formula to the other fomula debugger logs. + to the error in a Calc formula to the other formula debugger logs. * org.el (org-link-escape-chars-browser): Add char double quote. (org-open-at-point): Use the constant @@ -10556,7 +10556,7 @@ * org-element.el (org-element-paragraph-separate): Fix comments in paragraph separator regexp. Optimize it. - * org-element.el: Update code commets. + * org-element.el: Update code comments. * org.el (org-mark-subtree): Fix bug when marking subtree with point on an inlinetask. Refactor code. @@ -13798,7 +13798,7 @@ 2012-01-03 Dave Abrahams <dave@boostpro.com> * org-agenda.el (org-agenda-follow-indirect): New option. - (org-agenda-follow-mode): Call `org-agenda-do-context-action' fro + (org-agenda-follow-mode): Call `org-agenda-do-context-action' from follow mode. (org-agenda-do-context-action): Also do indirect follow mode action. @@ -17948,7 +17948,7 @@ * org.el (org-narrow-to-subtree): Ensure `org-back-to-heading' will move point to a real heading and not an inline task by - wraping function into a `org-with-limited-levels' macro. + wrapping function into a `org-with-limited-levels' macro. 2011-07-28 Bastien Guerry <bzg@gnu.org> @@ -20112,10 +20112,10 @@ 2011-05-10 Jim Meyering <meyering@redhat.com> Fix doubled-word typos. - * org-agenda.el (org-agenda-entry-types): the the -> the - * org-table.el (org-table-get-remote-range): or or -> or - * org-wl.el (org-wl-folder-type): the the -> the - * org.el (org-goto, org-inside-LaTeX-fragment-p): Likewise. + * org-agenda.el (org-agenda-entry-types): + * org-table.el (org-table-get-remote-range): + * org-wl.el (org-wl-folder-type): + * org.el (org-goto, org-inside-LaTeX-fragment-p): Fix typos. 2011-03-15 Stefan Monnier <monnier@iro.umontreal.ca> @@ -24341,7 +24341,7 @@ 2010-07-19 Bernt Hansen <bernt@norang.ca> * org.el (org-time-string-to-absolute): Ignore cyclic repeater - when displaying items on todays agenda date. + when displaying items on today's agenda date. 2010-07-19 Carsten Dominik <carsten.dominik@gmail.com> @@ -28477,7 +28477,7 @@ (outline-end-of-subtree): Make `outline-end-of-subtree' use the org-version of this function in Org-mode. We use advice to implement this change, so that future changes to this function in - outline.el wil be handled properly. + outline.el will be handled properly. (org-forward-same-level, org-backward-same-level): New commands. 2009-08-06 Carsten Dominik <carsten.dominik@gmail.com> @@ -28769,7 +28769,7 @@ attachments. * org-latex.el (org-export-latex-quotation-marks): Fix export of - quotation makrs in parenthesis. + quotation marks in parenthesis. (org-remove-initial-hash): New function. (org-export-latex-preprocess): Fix bug with infinite loop if environment is not properly closed. @@ -30559,7 +30559,7 @@ 2009-01-25 Carsten Dominik <carsten.dominik@gmail.com> * org-archive.el (org-extract-archive-heading): Allow %s for file - name also in achive location heading. + name also in archive location heading. 2009-01-25 Carsten Dominik <carsten.dominik@gmail.com> @@ -30650,7 +30650,7 @@ and scheduling search. * org-exp.el (org-html-handle-time-stamps): No longer check for - the `org-export-with-timestamps' option, because the preprocesser + the `org-export-with-timestamps' option, because the preprocessor has taken care of this already. * org.el (org-entry-properties): Catch the case when this is @@ -32411,7 +32411,7 @@ * org-exp.el (org-print-icalendar-entries): Move the call to `org-diary-to-ical-string' out of the loop, and kill the buffer - afterwords. + afterwards. * org-remember.el (org-remember-visit-immediately): Position cursor after moving to the note. diff --git a/lisp/org/ob-R.el b/lisp/org/ob-R.el index cd822ef8374..93d1d34229b 100644 --- a/lisp/org/ob-R.el +++ b/lisp/org/ob-R.el @@ -545,7 +545,7 @@ by `org-babel-comint-async-filter'." (defun ob-session-async-R-value-callback (params tmp-file) "Callback for async value results. -Assigned locally to `ob-session-async-file-callback' in R +Assigned locally to `org-babel-comint-async-file-callback' in R comint buffers used for asynchronous Babel evaluation." (let* ((graphics-file (and (member "graphics" (assq :result-params params)) (org-babel-graphical-output-file params))) diff --git a/lisp/org/ob-tangle.el b/lisp/org/ob-tangle.el index 525d27bc070..d9814a7aa64 100644 --- a/lisp/org/ob-tangle.el +++ b/lisp/org/ob-tangle.el @@ -433,7 +433,7 @@ non-nil, return the full association list to be used by ;; The created link is transient. Using ID is ;; not necessary, but could have side-effects if ;; used. An ID property may be added to - ;; existing entries thus creatin unexpected file + ;; existing entries thus creating unexpected file ;; modifications. (org-id-link-to-org-use-id nil) (l (org-no-properties (org-store-link nil)))) @@ -525,7 +525,7 @@ by `org-babel-get-src-block-info'." ("link" . ,(let (;; The created link is transient. Using ID is ;; not necessary, but could have side-effects if ;; used. An ID property may be added to - ;; existing entries thus creatin unexpected file + ;; existing entries thus creating unexpected file ;; modifications. (org-id-link-to-org-use-id nil)) (org-no-properties (org-store-link nil)))) diff --git a/lisp/org/ol.el b/lisp/org/ol.el index 4ad1f6d3452..108f031cde4 100644 --- a/lisp/org/ol.el +++ b/lisp/org/ol.el @@ -339,7 +339,7 @@ another window." (defcustom org-link-search-must-match-exact-headline 'query-to-create "Non-nil means internal fuzzy links can only match headlines. -When nil, the a fuzzy link may point to a target or a named +When nil, the fuzzy link may point to a target or a named construct in the document. When set to the special value `query-to-create', offer to create a new headline when none matched. diff --git a/lisp/org/org-clock.el b/lisp/org/org-clock.el index 38e0826075b..42de0a0cf97 100644 --- a/lisp/org/org-clock.el +++ b/lisp/org/org-clock.el @@ -428,8 +428,7 @@ When `org-clock-clocked-in-display' is set to `frame-title' or `both', clocking in will replace `frame-title-format' with this value. Clocking out will restore `frame-title-format'. -`org-frame-title-string' is a format string using the same -specifications than `frame-title-format', which see." +This uses the same format as `frame-title-format', which see." :version "24.1" :group 'org-clock :type 'sexp) diff --git a/lisp/org/org-ctags.el b/lisp/org/org-ctags.el index 67db49e9a67..b1ee32ab335 100644 --- a/lisp/org/org-ctags.el +++ b/lisp/org/org-ctags.el @@ -45,8 +45,6 @@ ;; Installation ;; ============ ;; -;; Install org mode -;; Ensure org-ctags.el is somewhere in your emacs load path. ;; Download and install Exuberant ctags -- "https://ctags.sourceforge.net/" ;; Edit your .emacs file (see next section) and load emacs. diff --git a/lisp/org/org-element.el b/lisp/org/org-element.el index 4c018062af3..474a93577a9 100644 --- a/lisp/org/org-element.el +++ b/lisp/org/org-element.el @@ -139,7 +139,7 @@ is not sufficient to know if point is at a paragraph ending. See (defvar org-element--object-regexp nil "Regexp possibly matching the beginning of an object. This regexp allows false positives. Dedicated parser (e.g., -`org-export-bold-parser') will take care of further filtering. +`org-element-bold-parser') will take care of further filtering. Radio links are not matched by this regexp, as they are treated specially in `org-element--object-lex'.") diff --git a/lisp/org/org-faces.el b/lisp/org/org-faces.el index d96898372f9..78148a1b6d1 100644 --- a/lisp/org/org-faces.el +++ b/lisp/org/org-faces.el @@ -137,7 +137,7 @@ The following faces apply, with this priority. Since column view works by putting overlays with a display property over individual characters in the buffer, the face of the underlining -character (this might for example be the a TODO keyword) might still +character (this might for example be the TODO keyword) might still shine through in some properties. So when your column view looks funny, with \"random\" colors, weight, strike-through, try to explicitly set the properties in the `org-column' face. For example, set diff --git a/lisp/org/org-id.el b/lisp/org/org-id.el index 7334050b8b4..2fb299d5e89 100644 --- a/lisp/org/org-id.el +++ b/lisp/org/org-id.el @@ -591,7 +591,7 @@ If SILENT is non-nil, messages are suppressed." (setf (car item) (expand-file-name (car item) loc)))) org-id-locations))) (error - (message "Could not read `org-id-values' from %s, setting it to nil" + (message "Could not read `org-id-locations' from %s, setting it to nil" org-id-locations-file)))) (setq org-id-files (mapcar 'car org-id-locations)) (setq org-id-locations (org-id-alist-to-hash org-id-locations)))) diff --git a/lisp/org/org-protocol.el b/lisp/org/org-protocol.el index 7a91a33b745..cd99f30e7bd 100644 --- a/lisp/org/org-protocol.el +++ b/lisp/org/org-protocol.el @@ -42,7 +42,6 @@ ;; ;; 1.) Add this to your init file (.emacs probably): ;; -;; (add-to-list 'load-path "/path/to/org-protocol/") ;; (require 'org-protocol) ;; ;; 3.) Ensure emacs-server is up and running. @@ -688,7 +687,7 @@ to deal with new-style links.") fname))) (defadvice server-visit-files (before org-protocol-detect-protocol-server activate) - "Advice server-visit-flist to call `org-protocol-modify-filename-for-protocol'." + "Advice server-visit-flist to call `org-protocol-check-filename-for-protocol'." (let ((flist (if org-protocol-reverse-list-of-files (reverse (ad-get-arg 0)) (ad-get-arg 0))) diff --git a/lisp/org/ox-koma-letter.el b/lisp/org/ox-koma-letter.el index 5f62cd1c040..6b5edd20f5a 100644 --- a/lisp/org/ox-koma-letter.el +++ b/lisp/org/ox-koma-letter.el @@ -35,7 +35,7 @@ ;; `org-koma-letter-export-to-pdf' ("pdf" file). ;; ;; On top of buffer keywords supported by `latex' back-end (see -;; `org-latex-options-alist'), this back-end introduces the following +;; `org-latex-packages-alist'), this back-end introduces the following ;; keywords: ;; - CLOSING: see `org-koma-letter-closing', ;; - FROM_ADDRESS: see `org-koma-letter-from-address', @@ -66,7 +66,7 @@ ;; - from-logo (see `org-koma-letter-use-from-logo') ;; - email (see `org-koma-letter-use-email') ;; - place (see `org-koma-letter-use-place') -;; - location (see `org-koma-letter-use-location') +;; - location (see `org-koma-letter-location') ;; - subject, a list of format options ;; (see `org-koma-letter-subject-format') ;; - after-closing-order, a list of the ordering of headings with diff --git a/lisp/org/ox-odt.el b/lisp/org/ox-odt.el index 7f2e8ba47f8..8c8c80136ae 100644 --- a/lisp/org/ox-odt.el +++ b/lisp/org/ox-odt.el @@ -3227,8 +3227,7 @@ Return a cons of (TABLE-CELL-STYLE-NAME . PARAGRAPH-STYLE-NAME). When STYLE-SPEC is nil, style the table cell the conventional way - choose cell borders based on row and column groupings and choose paragraph alignment based on `org-col-cookies' text -property. See also -`org-odt-get-paragraph-style-cookie-for-table-cell'. +property. See also `org-odt-table-style-spec'. When STYLE-SPEC is non-nil, ignore the above cookie and return styles congruent with the ODF-1.2 specification." @@ -3573,8 +3572,7 @@ pertaining to indentation here." ;; item, but also within description lists and low-level ;; headlines. - ;; See `org-odt-translate-description-lists' and - ;; `org-odt-translate-low-level-headlines' for how this is + ;; See `org-odt--translate-description-lists' for how this is ;; tackled. (concat "\n" diff --git a/lisp/org/ox.el b/lisp/org/ox.el index 56bb4b74df3..ca6b3f22080 100644 --- a/lisp/org/ox.el +++ b/lisp/org/ox.el @@ -6291,7 +6291,7 @@ to `:default' encoding. If it fails, return S." ;; ;; Export Stack is viewed through a dedicated major mode ;;`org-export-stack-mode' and tools: `org-export-stack-refresh', -;;`org-export-stack-delete', `org-export-stack-view' and +;;`org-export-stack-remove', `org-export-stack-view' and ;;`org-export-stack-clear'. ;; ;; For back-ends, `org-export-add-to-stack' add a new source to stack. diff --git a/lisp/outline.el b/lisp/outline.el index a646f71db8b..2465a4963ab 100644 --- a/lisp/outline.el +++ b/lisp/outline.el @@ -59,6 +59,18 @@ The recommended way to set this is with a `Local Variables:' list in the file it applies to.") ;;;###autoload(put 'outline-heading-end-regexp 'safe-local-variable 'stringp) +(defvar outline-search-function nil + "Function to search the next outline heading. +The function is called with four optional arguments: BOUND, MOVE, BACKWARD, +LOOKING-AT. The first two arguments BOUND and MOVE are almost the same as +the BOUND and NOERROR arguments of `re-search-forward', with the difference +that MOVE accepts only a boolean, either nil or non-nil. When the argument +BACKWARD is non-nil, the search should search backward like +`re-search-backward' does. In case of a successful search, the +function should return non-nil, move point, and set match-data +appropriately. When the argument LOOKING-AT is non-nil, it should +imitate the function `looking-at'.") + (defvar outline-mode-prefix-map (let ((map (make-sparse-keymap))) (define-key map "@" 'outline-mark-subtree) @@ -233,7 +245,8 @@ This option is only in effect when `outline-minor-mode-cycle' is non-nil." (defvar outline-font-lock-keywords '( ;; Highlight headings according to the level. - (eval . (list (concat "^\\(?:" outline-regexp "\\).*") + (eval . (list (or outline-search-function + (concat "^\\(?:" outline-regexp "\\).*")) 0 '(if outline-minor-mode (if outline-minor-mode-highlight (list 'face (outline-font-lock-face))) @@ -366,7 +379,9 @@ data reflects the `outline-regexp'.") "Return one of `outline-font-lock-faces' for current level." (save-excursion (goto-char (match-beginning 0)) - (looking-at outline-regexp) + (if outline-search-function + (funcall outline-search-function nil nil nil t) + (looking-at outline-regexp)) (aref outline-font-lock-faces (% (1- (funcall outline-level)) (length outline-font-lock-faces))))) @@ -454,7 +469,7 @@ bindings, per the current major mode." (defcustom outline-minor-mode-highlight nil "Whether to highlight headings in `outline-minor-mode' using font-lock keywords. -This option controles whether `outline-minor-mode' will use its font-lock +This option controls 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. @@ -474,8 +489,11 @@ outline font-lock faces to those of major mode." ;; Fallback to overlays when font-lock is unsupported. (save-excursion (goto-char (point-min)) - (let ((regexp (concat "^\\(?:" outline-regexp "\\).*$"))) - (while (re-search-forward regexp nil t) + (let ((regexp (unless outline-search-function + (concat "^\\(?:" outline-regexp "\\).*$")))) + (while (if outline-search-function + (funcall outline-search-function) + (re-search-forward regexp nil t)) (let ((overlay (make-overlay (match-beginning 0) (match-end 0)))) (overlay-put overlay 'outline-highlight t) ;; FIXME: Is it possible to override all underlying face attributes? @@ -592,26 +610,37 @@ or else the number of characters matched by `outline-regexp'." "Skip forward to just before the next heading line. If there's no following heading line, stop before the newline at the end of the buffer." - (if (re-search-forward (concat "\n\\(?:" outline-regexp "\\)") - nil 'move) - (goto-char (match-beginning 0))) - (if (and (bolp) (or outline-blank-line (eobp)) (not (bobp))) - (forward-char -1))) + (when (if outline-search-function + (progn + ;; Emulate "\n" to force finding the next preface + (unless (eobp) (forward-char 1)) + (funcall outline-search-function nil t)) + (re-search-forward (concat "\n\\(?:" outline-regexp "\\)") + nil 'move)) + (goto-char (match-beginning 0)) + ;; Compensate "\n" from the beginning of regexp + (when (and outline-search-function (not (bobp))) (forward-char -1))) + (when (and (bolp) (or outline-blank-line (eobp)) (not (bobp))) + (forward-char -1))) (defun outline-next-heading () "Move to the next (possibly invisible) heading line." (interactive) ;; Make sure we don't match the heading we're at. - (if (and (bolp) (not (eobp))) (forward-char 1)) - (if (re-search-forward (concat "^\\(?:" outline-regexp "\\)") - nil 'move) - (goto-char (match-beginning 0)))) + (when (and (bolp) (not (eobp))) (forward-char 1)) + (when (if outline-search-function + (funcall outline-search-function nil t) + (re-search-forward (concat "^\\(?:" outline-regexp "\\)") + nil 'move)) + (goto-char (match-beginning 0)))) (defun outline-previous-heading () "Move to the previous (possibly invisible) heading line." (interactive) - (re-search-backward (concat "^\\(?:" outline-regexp "\\)") - nil 'move)) + (if outline-search-function + (funcall outline-search-function nil t t) + (re-search-backward (concat "^\\(?:" outline-regexp "\\)") + nil 'move))) (defsubst outline-invisible-p (&optional pos) "Non-nil if the character after POS has outline invisible property. @@ -628,8 +657,10 @@ Only visible heading lines are considered, unless INVISIBLE-OK is non-nil." (let (found) (save-excursion (while (not found) - (or (re-search-backward (concat "^\\(?:" outline-regexp "\\)") - nil t) + (or (if outline-search-function + (funcall outline-search-function nil nil t) + (re-search-backward (concat "^\\(?:" outline-regexp "\\)") + nil t)) (signal 'outline-before-first-heading nil)) (setq found (and (or invisible-ok (not (outline-invisible-p))) (point))))) @@ -642,7 +673,9 @@ If INVISIBLE-OK is non-nil, an invisible heading line is ok too." (save-excursion (beginning-of-line) (and (bolp) (or invisible-ok (not (outline-invisible-p))) - (looking-at outline-regexp)))) + (if outline-search-function + (funcall outline-search-function nil nil nil t) + (looking-at outline-regexp))))) (defun outline-insert-heading () "Insert a new heading at same depth at point." @@ -754,7 +787,9 @@ nil for WHICH, or do not pass any argument)." (while (and (progn (outline-next-heading) (not (eobp))) (<= (funcall outline-level) level)))) (unless (eobp) - (looking-at outline-regexp) + (if outline-search-function + (funcall outline-search-function nil nil nil t) + (looking-at outline-regexp)) (match-string-no-properties 0)))) ;; Bummer!! There is no higher-level heading in the buffer. (outline-invent-heading head nil)))) @@ -805,7 +840,9 @@ the match data is set appropriately." (save-excursion (setq end (copy-marker end)) (goto-char beg) - (when (re-search-forward (concat "^\\(?:" outline-regexp "\\)") end t) + (when (if outline-search-function + (funcall outline-search-function end) + (re-search-forward (concat "^\\(?:" outline-regexp "\\)") end t)) (goto-char (match-beginning 0)) (funcall fun) (while (and (progn @@ -873,21 +910,23 @@ A heading line is one that starts with a `*' (or that (if (< arg 0) (beginning-of-line) (end-of-line)) - (let (found-heading-p) + (let ((regexp (unless outline-search-function + (concat "^\\(?:" outline-regexp "\\)"))) + found-heading-p) (while (and (not (bobp)) (< arg 0)) (while (and (not (bobp)) (setq found-heading-p - (re-search-backward - (concat "^\\(?:" outline-regexp "\\)") - nil 'move)) + (if outline-search-function + (funcall outline-search-function nil t t) + (re-search-backward regexp nil 'move))) (outline-invisible-p))) (setq arg (1+ arg))) (while (and (not (eobp)) (> arg 0)) (while (and (not (eobp)) (setq found-heading-p - (re-search-forward - (concat "^\\(?:" outline-regexp "\\)") - nil 'move)) + (if outline-search-function + (funcall outline-search-function nil t) + (re-search-forward regexp nil 'move))) (outline-invisible-p (match-beginning 0)))) (setq arg (1- arg))) (if found-heading-p (beginning-of-line)))) @@ -1026,6 +1065,8 @@ Note that this does not hide the lines preceding the first heading line." ;; Nullify the hook to avoid repeated calls to `outline-flag-region' ;; wasting lots of time running `lazy-lock-fontify-after-outline' ;; and run the hook finally. + ;; FIXME: The above comment seems outdated, as lazy-lock has been + ;; removed from Emacs. (let (outline-view-change-hook) (save-excursion (save-restriction @@ -1107,8 +1148,11 @@ of the current heading, or to 1 if the current line is not a heading." (interactive (list (cond (current-prefix-arg (prefix-numeric-value current-prefix-arg)) - ((save-excursion (beginning-of-line) - (looking-at outline-regexp)) + ((save-excursion + (beginning-of-line) + (if outline-search-function + (funcall outline-search-function nil nil nil t) + (looking-at outline-regexp))) (funcall outline-level)) (t 1)))) (if (< levels 1) @@ -1255,7 +1299,9 @@ If INVISIBLE-OK is non-nil, also consider invisible lines." (setq level (funcall outline-level))) (setq start-level level)) (setq arg (- arg 1)))) - (looking-at outline-regexp)) + (if outline-search-function + (funcall outline-search-function nil nil nil t) + (looking-at outline-regexp))) (defun outline-forward-same-level (arg) "Move forward to the ARG'th subheading at same level as this one. @@ -1313,6 +1359,60 @@ If there is no such heading, return nil." (if (< (funcall outline-level) level) nil (point))))) + + +;;; Search text-property for outline headings + +;;;###autoload +(defun outline-search-level (&optional bound move backward looking-at) + "Search for the next text property `outline-level'. +The arguments are the same as in `outline-search-text-property', +except the hard-coded property name `outline-level'. +This function is intended to be used in `outline-search-function'." + (outline-search-text-property 'outline-level nil bound move backward looking-at)) + +(autoload 'text-property-search-forward "text-property-search") +(autoload 'text-property-search-backward "text-property-search") + +(defun outline-search-text-property (property &optional value bound move backward looking-at) + "Search for the next text property PROPERTY with VALUE. +The rest of arguments are described in `outline-search-function'." + (if looking-at + (when (if value (eq (get-text-property (point) property) value) + (get-text-property (point) property)) + (set-match-data (list (pos-bol) (pos-eol))) + t) + ;; Go to the end when in the middle of heading + (when (and (not backward) + (if value (eq (get-text-property (point) property) value) + (get-text-property (point) property)) + (not (or (bobp) + (not (if value + (eq (get-text-property (1- (point)) property) value) + (get-text-property (1- (point)) property)))))) + (goto-char (1+ (pos-eol)))) + (let ((prop-match (if backward + (text-property-search-backward property value (and value t)) + (text-property-search-forward property value (and value t))))) + (if prop-match + (let ((beg (prop-match-beginning prop-match)) + (end (prop-match-end prop-match))) + (if (or (null bound) (if backward (>= beg bound) (<= end bound))) + (cond (backward + (goto-char beg) + (goto-char (pos-bol)) + (set-match-data (list (point) end)) + t) + (t + (goto-char end) + (goto-char (if (bolp) (1- (point)) (pos-eol))) + (set-match-data (list beg (point))) + t)) + (when move (goto-char bound)) + nil)) + (when move (goto-char (or bound (if backward (point-min) (point-max))))) + nil)))) + (defun outline-headers-as-kill (beg end) "Save the visible outline headers between BEG and END to the kill ring. diff --git a/lisp/pcomplete.el b/lisp/pcomplete.el index 8cb0aa3b7ad..ef286b70fe0 100644 --- a/lisp/pcomplete.el +++ b/lisp/pcomplete.el @@ -1210,9 +1210,7 @@ Returns nil if no completion was inserted. Returns `sole' if completed with the only completion match. Returns `shortest' if completed with the shortest of the matches. Returns `partial' if completed as far as possible with the matches. -Returns `listed' if a completion listing was shown. - -See also `pcomplete-filename'." +Returns `listed' if a completion listing was shown." (let* ((completion-ignore-case completion-ignore-case) (completions (all-completions stub candidates)) (entry (try-completion stub candidates)) diff --git a/lisp/proced.el b/lisp/proced.el index a774f2dd1e2..ac44ae1513d 100644 --- a/lisp/proced.el +++ b/lisp/proced.el @@ -140,8 +140,8 @@ the external command (usually \"kill\")." (nice "Ni" "%3d" 3 proced-< t (nice pid) (t t nil)) (thcount "THCount" "%d" right proced-< t (thcount pid) (nil t t)) (start "Start" proced-format-start 6 proced-time-lessp nil (start pid) (t t nil)) - (vsize "VSize" "%d" right proced-< t (vsize pid) (nil t t)) - (rss "RSS" "%d" right proced-< t (rss pid) (nil t t)) + (vsize "VSize" proced-format-memory right proced-< t (vsize pid) (nil t t)) + (rss "RSS" proced-format-memory right proced-< t (rss pid) (nil t t)) (etime "ETime" proced-format-time right proced-time-lessp t (etime pid) (nil t t)) (pcpu "%CPU" "%.1f" right proced-< t (pcpu pid) (nil t t)) (pmem "%Mem" "%.1f" right proced-< t (pmem pid) (nil t t)) @@ -740,12 +740,18 @@ Proced buffers." "Type \\<proced-mode-map>\\[quit-window] to quit, \\[proced-help] for help"))))) (defun proced-auto-update-timer () - "Auto-update Proced buffers using `run-at-time'." - (dolist (buf (buffer-list)) - (with-current-buffer buf - (if (and (eq major-mode 'proced-mode) - proced-auto-update-flag) - (proced-update t t))))) + "Auto-update Proced buffers using `run-at-time'. + +If there are no proced buffers, cancel the timer." + (unless (seq-filter (lambda (buf) + (with-current-buffer buf + (when (eq major-mode 'proced-mode) + (if proced-auto-update-flag + (proced-update t t)) + t))) + (buffer-list)) + (cancel-timer proced-auto-update-timer) + (setq proced-auto-update-timer nil))) (defun proced-toggle-auto-update (arg) "Change whether this Proced buffer is updated automatically. @@ -1425,6 +1431,10 @@ The return string is always 6 characters wide." Replace newline characters by \"^J\" (two characters)." (string-replace "\n" "^J" args)) +(defun proced-format-memory (kilobytes) + "Format KILOBYTES in a human readable format." + (funcall byte-count-to-string-function (* 1024 kilobytes))) + (defun proced-format (process-alist format) "Display PROCESS-ALIST using FORMAT." (if (symbolp format) diff --git a/lisp/progmodes/cc-bytecomp.el b/lisp/progmodes/cc-bytecomp.el index 4b8154dafe4..735d829769b 100644 --- a/lisp/progmodes/cc-bytecomp.el +++ b/lisp/progmodes/cc-bytecomp.el @@ -287,7 +287,7 @@ perhaps a `cc-bytecomp-restore-environment' is forgotten somewhere")) (cons cc-file cc-bytecomp-loaded-files)) (cc-bytecomp-debug-msg "cc-bytecomp-load: Loading %S" cc-file) - ;; native-comp may async compile also intalled el.gz + ;; native-comp may async compile also installed el.gz ;; files therefore we may have to load here other el.gz. (load cc-part nil t) (cc-bytecomp-debug-msg diff --git a/lisp/progmodes/cc-cmds.el b/lisp/progmodes/cc-cmds.el index 38e9d6011df..7bfd6bdbd91 100644 --- a/lisp/progmodes/cc-cmds.el +++ b/lisp/progmodes/cc-cmds.el @@ -1456,7 +1456,7 @@ keyword on the line, the keyword is not inserted inside a literal, and (defun c-align-cpp-indent-to-body () "Align a \"#pragma\" line under the previous line. -This function is intented for use as a member of `c-special-indent-hook'." +This function is intended for use as a member of `c-special-indent-hook'." (when (assq 'cpp-macro c-syntactic-context) (when (save-excursion diff --git a/lisp/progmodes/cc-defs.el b/lisp/progmodes/cc-defs.el index 81aac2ec274..b13f6a5914e 100644 --- a/lisp/progmodes/cc-defs.el +++ b/lisp/progmodes/cc-defs.el @@ -86,7 +86,7 @@ ;;; Variables also used at compile time. -(defconst c-version "5.35.1" +(defconst c-version "5.35.2" "CC Mode version number.") (defconst c-version-sym (intern c-version)) diff --git a/lisp/progmodes/cc-engine.el b/lisp/progmodes/cc-engine.el index a13a0c838af..7e6dd431756 100644 --- a/lisp/progmodes/cc-engine.el +++ b/lisp/progmodes/cc-engine.el @@ -6052,7 +6052,7 @@ comment at the start of cc-engine.el for more info." ;; the like. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; The approximate interval at which we cache the value of the brace stack. -(defconst c-bs-interval 5000) +(defconst c-bs-interval 2000) ;; The list of cached values of the brace stack. Each value in the list is a ;; cons of the position it is valid for and the value of the stack as ;; described above. @@ -6963,7 +6963,7 @@ comment at the start of cc-engine.el for more info." ;; At each buffer change, the syntax-table properties are removed in a ;; before-change function and reapplied, when needed, in an ;; after-change function. It is far more important that the -;; properties get removed when they they are spurious than that they +;; properties get removed when they are spurious than that they ;; be present when wanted. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun c-clear-<-pair-props (&optional pos) @@ -7356,7 +7356,7 @@ multi-line strings (but not C++, for example)." (defun c-ml-string-opener-intersects-region (&optional start finish) ;; If any part of the region [START FINISH] is inside an ml-string opener, ;; return a dotted list of the start, end and double-quote position of that - ;; opener. That list wlll not include any "context characters" before or + ;; opener. That list will not include any "context characters" before or ;; after the opener. If an opener is found, the match-data will indicate ;; it, with (match-string 1) being the entire delimiter, and (match-string ;; 2) the "main" double-quote. Otherwise, the match-data is undefined. @@ -9036,7 +9036,8 @@ multi-line strings (but not C++, for example)." ;; o - 'found if it's a type that matches one in `c-found-types'; ;; o - 'maybe if it's an identifier that might be a type; ;; o - 'decltype if it's a decltype(variable) declaration; - or - ;; o - 'no-id if "auto" precluded parsing a type identifier. + ;; o - 'no-id if "auto" precluded parsing a type identifier (C++) + ;; or the type int was implicit (C). ;; o - nil if it can't be a type (the point isn't moved then). ;; ;; The point is assumed to be at the beginning of a token. @@ -9060,10 +9061,11 @@ multi-line strings (but not C++, for example)." ;; Skip leading type modifiers. If any are found we know it's a ;; prefix of a type. - (when c-opt-type-modifier-prefix-key ; e.g. "const" "volatile", but NOT "typedef" - (while (looking-at c-opt-type-modifier-prefix-key) - (when (looking-at c-no-type-key) - (setq res 'no-id)) + (when c-maybe-typeless-specifier-re + (while (looking-at c-maybe-typeless-specifier-re) + (save-match-data + (when (looking-at c-no-type-key) + (setq res 'no-id))) (goto-char (match-end 1)) (c-forward-syntactic-ws) (or (eq res 'no-id) @@ -9128,6 +9130,9 @@ multi-line strings (but not C++, for example)." (not (eq res 'no-id)) (progn (setq pos nil) + (while (and c-opt-cpp-prefix + (looking-at c-noise-macro-with-parens-name-re)) + (c-forward-noise-clause)) (if (looking-at c-identifier-start) (save-excursion (setq id-start (point) @@ -9187,6 +9192,18 @@ multi-line strings (but not C++, for example)." (goto-char (match-end 1)) (c-forward-syntactic-ws))))) + ((and (eq name-res t) + (eq res 'prefix) + (c-major-mode-is 'c-mode) + (save-excursion + (goto-char id-end) + (and (not (looking-at c-symbol-start)) + (not (looking-at c-type-decl-prefix-key))))) + ;; A C specifier followed by an implicit int, e.g. + ;; "register count;" + (goto-char id-start) + (setq res 'no-id)) + (name-res (cond ((eq name-res t) ;; A normal identifier. @@ -9224,7 +9241,11 @@ multi-line strings (but not C++, for example)." (t ;; Otherwise it's an operator identifier, which is not a type. (goto-char start) - (setq res nil))))) + (setq res nil)))) + + ((eq res 'prefix) + ;; Deal with "extern "C" foo_t my_foo;" + (setq res nil))) (when (not (memq res '(nil no-id))) ;; Skip trailing type modifiers. If any are found we know it's @@ -10012,9 +10033,11 @@ This function might do hidden buffer changes." got-suffix-after-parens id-start paren-depth 0)) - (if (setq at-type (if (eq backup-at-type 'prefix) - t - backup-at-type)) + (if (not (memq + (setq at-type (if (eq backup-at-type 'prefix) + t + backup-at-type)) + '(nil no-id))) (setq type-start backup-type-start id-start backup-id-start) (setq type-start start-pos @@ -11079,6 +11102,11 @@ This function might do hidden buffer changes." ;; `got-parens' or `got-suffix' is set it's "a()", "a[]", "a()[]", ;; or similar, which we accept only if the context rules out ;; expressions. + ;; + ;; If we've got at-type 'maybe, we cannot confidently promote the + ;; possible type to a found type. + (when (and (eq at-type 'maybe)) + (setq unsafe-maybe t)) (throw 'at-decl-or-cast t))) ;; If we had a complete symbol table here (which rules out @@ -11214,7 +11242,8 @@ This function might do hidden buffer changes." ;; Record the type's coordinates in `c-record-type-identifiers' for ;; later fontification. - (when (and c-record-type-identifiers at-type ;; (not (eq at-type t)) + (when (and c-record-type-identifiers + (not (memq at-type '(nil no-id))) ;; There seems no reason to exclude a token from ;; fontification just because it's "a known type that can't ;; be a name or other expression". 2013-09-18. @@ -12597,7 +12626,7 @@ comment at the start of cc-engine.el for more info." (defun c-laomib-fix-elt (lwm elt paren-state) ;; Correct a c-laomib-cache entry ELT with respect to buffer changes, either - ;; doing nothing, signalling it is to be deleted, or replacing its start + ;; doing nothing, signaling it is to be deleted, or replacing its start ;; point with one lower in the buffer than LWM. PAREN-STATE is the paren ;; state at LWM. Return the corrected entry, or nil (if it needs deleting). ;; Note that corrections are made by `setcar'ing the original structure, diff --git a/lisp/progmodes/cc-langs.el b/lisp/progmodes/cc-langs.el index 291af038b79..561aa0f7e5b 100644 --- a/lisp/progmodes/cc-langs.el +++ b/lisp/progmodes/cc-langs.el @@ -2713,7 +2713,7 @@ before the type, so such things are not necessary to mention here. Mentioning them here is necessary only if they can occur in other places, or if they are followed by a construct that must be skipped over (like the parens in the \"__attribute__\" and \"__declspec\" -examples above). In the last case, they alse need to be present on +examples above). In the last case, they also need to be present on one of `c-type-list-kwds', `c-ref-list-kwds', `c-colon-type-list-kwds', `c-paren-nontype-kwds', `c-paren-type-kwds', `c-<>-type-kwds', or `c-<>-arglist-kwds'." @@ -3869,6 +3869,14 @@ possible for good performance." t) "\\>"))) +(c-lang-defconst c-maybe-typeless-specifier-re + "Regexp matching keywords which might, but needn't, declare variables with +no explicit type given, or nil in languages without such specifiers." + t (c-lang-const c-opt-type-modifier-prefix-key) + c (c-lang-const c-type-decl-prefix-keywords-key)) +(c-lang-defvar c-maybe-typeless-specifier-re + (c-lang-const c-maybe-typeless-specifier-re)) + (c-lang-defconst c-type-decl-prefix-key "Regexp matching any declarator operator that might precede the identifier in a declaration, e.g. the \"*\" in \"char *argv\". This diff --git a/lisp/progmodes/cc-mode.el b/lisp/progmodes/cc-mode.el index 2aa6b90dea3..5a610253e01 100644 --- a/lisp/progmodes/cc-mode.el +++ b/lisp/progmodes/cc-mode.el @@ -1235,7 +1235,7 @@ Note that the style variables are always made local to the buffer." (defun c-multiline-string-check-final-quote () ;; Check that the final quote in the buffer is correctly marked or not with - ;; a string-fence syntax-table text propery. The return value has no + ;; a string-fence syntax-table text property. The return value has no ;; significance. (let (pos-ll pos-lt) (save-excursion @@ -2390,6 +2390,8 @@ with // and /*, not more generic line and block comments." ;; Go to a less nested declaration each time round this loop. (and (setq old-pos (point)) + ;; The following form tries to move to the end of the previous + ;; declaration without moving outside of an enclosing {. (let (pseudo) (while (and @@ -2404,7 +2406,9 @@ with // and /*, not more generic line and block comments." (setq pseudo (c-cheap-inside-bracelist-p (c-parse-state))))))) (goto-char pseudo)) t) - (>= (point) bod-lim) + (or (> (point) bod-lim) + (eq bod-lim (point-min))) + ;; Move forward to the start of the next declaration. (progn (c-forward-syntactic-ws) ;; Have we got stuck in a comment at EOB? (not (and (eobp) @@ -2501,7 +2505,7 @@ with // and /*, not more generic line and block comments." (not (eobp))) (progn (c-forward-over-token) - ;; Cope with having POS withing a syntactically invalid + ;; Cope with having POS within a syntactically invalid ;; (...), by moving backward out of the parens and trying ;; again. (when (and (eq (char-before) ?\)) diff --git a/lisp/progmodes/ebnf2ps.el b/lisp/progmodes/ebnf2ps.el index 6e42da2d54f..36849492be4 100644 --- a/lisp/progmodes/ebnf2ps.el +++ b/lisp/progmodes/ebnf2ps.el @@ -166,8 +166,6 @@ ;; ;; Where setup-ebnf2ps.el should be a file containing: ;; -;; ;; set load-path if ebnf2ps isn't installed in your Emacs environment -;; (setq load-path (append (list "/dir/of/ebnf2ps") load-path)) ;; (require 'ebnf2ps) ;; ;; insert here your ebnf2ps settings ;; (setq ebnf-terminal-shape 'bevel) @@ -4284,7 +4282,7 @@ end (ebnf-eps-header-footer ebnf-eps-footer)) -;; hacked fom `ps-output-string-prim' (ps-print.el) +;; hacked from `ps-output-string-prim' (ps-print.el) (defun ebnf-eps-string (string) (let* ((str string) (len (length str)) @@ -4405,9 +4403,9 @@ end (defvar ebnf-nprod 0) -(defsubst ebnf-message-info (messag) +(defsubst ebnf-message-info (msg) (message "%s...%3d%%" - messag + msg (round (/ (* (setq ebnf-nprod (1+ ebnf-nprod)) 100.0) ebnf-total)))) diff --git a/lisp/progmodes/eglot.el b/lisp/progmodes/eglot.el index ce989b56117..bbd902c1c7d 100644 --- a/lisp/progmodes/eglot.el +++ b/lisp/progmodes/eglot.el @@ -9,7 +9,7 @@ ;; Keywords: convenience, languages ;; Package-Requires: ((emacs "26.3") (jsonrpc "1.0.14") (flymake "1.2.1") (project "0.3.0") (xref "1.0.1") (eldoc "1.11.0") (seq "2.23")) -;; This is is a GNU ELPA :core package. Avoid adding functionality +;; This is a GNU ELPA :core package. Avoid adding functionality ;; that is not available in the version of Emacs recorded above or any ;; of the package dependencies. @@ -56,7 +56,7 @@ ;; available as GNU ELPA :core packages. Historically, a number of ;; :core packages were added or reworked in Emacs to make this ;; possible. This principle should be upheld when adding new LSP -;; features or tweaking exising ones. Design any new facilities in +;; features or tweaking existing ones. Design any new facilities in ;; a way that they could work in the absence of LSP or using some ;; different protocol, then make sure Eglot can link up LSP ;; information to it. @@ -192,8 +192,9 @@ chosen (interactively or automatically)." . ("typescript-language-server" "--stdio")) (sh-mode . ("bash-language-server" "start")) ((php-mode phps-mode) - . ("php" "vendor/felixfbecker/\ -language-server/bin/php-language-server.php")) + . ,(eglot-alternatives + '(("phpactor" "language-server") + ("php" "vendor/felixfbecker/language-server/bin/php-language-server.php")))) ((c++-mode c-mode) . ,(eglot-alternatives '("clangd" "ccls"))) (((caml-mode :language-id "ocaml") @@ -206,7 +207,7 @@ language-server/bin/php-language-server.php")) (elm-mode . ("elm-language-server")) (mint-mode . ("mint" "ls")) (kotlin-mode . ("kotlin-language-server")) - (go-mode . ("gopls")) + ((go-mode go-dot-mod-mode go-dot-work-mode) . ("gopls")) ((R-mode ess-r-mode) . ("R" "--slave" "-e" "languageserver::run()")) (java-mode . ("jdtls")) @@ -217,7 +218,7 @@ language-server/bin/php-language-server.php")) (scala-mode . ("metals-emacs")) (racket-mode . ("racket" "-l" "racket-langserver")) ((tex-mode context-mode texinfo-mode bibtex-mode) - . ("digestif")) + . ,(eglot-alternatives '("digestif" "texlab"))) (erlang-mode . ("erlang_ls" "--transport" "stdio")) (yaml-mode . ("yaml-language-server" "--stdio")) (nix-mode . ,(eglot-alternatives '("nil" "rnix-lsp"))) @@ -234,7 +235,7 @@ language-server/bin/php-language-server.php")) . ("clojure-lsp")) (csharp-mode . ("omnisharp" "-lsp")) (purescript-mode . ("purescript-language-server" "--stdio")) - (perl-mode . ("perl" "-MPerl::LanguageServer" "-e" "Perl::LanguageServer::run")) + ((perl-mode cperl-mode) . ("perl" "-MPerl::LanguageServer" "-e" "Perl::LanguageServer::run")) (markdown-mode . ("marksman" "server"))) "How the command `eglot' guesses the server to start. An association list of (MAJOR-MODE . CONTACT) pairs. MAJOR-MODE @@ -298,7 +299,10 @@ CONTACT can be: the call is interactive, the function can ask the user for hints on finding the required programs, etc. Otherwise, it should not ask the user for any input, and return nil or signal - an error if it can't produce a valid CONTACT.") + an error if it can't produce a valid CONTACT. The helper + function `eglot-alternatives' (which see) can be used to + produce a function that offers more than one server for a given + MAJOR-MODE.") (defface eglot-highlight-symbol-face '((t (:inherit bold))) @@ -583,7 +587,7 @@ on unknown notifications and errors on unknown requests.")) (cl-defmacro eglot--dbind (vars object &body body) "Destructure OBJECT, binding VARS in BODY. VARS is ([(INTERFACE)] SYMS...) -Honour `eglot-strict-mode'." +Honor `eglot-strict-mode'." (declare (indent 2) (debug (sexp sexp &rest form))) (let ((interface-name (if (consp (car vars)) (car (pop vars)))) @@ -610,7 +614,7 @@ Honour `eglot-strict-mode'." (cl-defmacro eglot--lambda (cl-lambda-list &body body) "Function of args CL-LAMBDA-LIST for processing INTERFACE objects. -Honour `eglot-strict-mode'." +Honor `eglot-strict-mode'." (declare (indent 1) (debug (sexp &rest form))) (let ((e (cl-gensym "jsonrpc-lambda-elem"))) `(lambda (,e) (eglot--dbind ,cl-lambda-list ,e ,@body)))) @@ -817,9 +821,6 @@ treated as in `eglot--dbind'." (project :documentation "Project associated with server." :accessor eglot--project) - (spinner - :documentation "List (ID DOING-WHAT DONE-P) representing server progress." - :initform `(nil nil t) :accessor eglot--spinner) (inhibit-autoreconnect :initform t :documentation "Generalized boolean inhibiting auto-reconnection if true." @@ -877,7 +878,8 @@ SERVER." PRESERVE-BUFFERS as in `eglot-shutdown', which see." (interactive (list current-prefix-arg)) (cl-loop for ss being the hash-values of eglot--servers-by-project - do (cl-loop for s in ss do (eglot-shutdown s nil nil preserve-buffers)))) + do (with-demoted-errors "[eglot] shutdown all: %s" + (cl-loop for s in ss do (eglot-shutdown s nil nil preserve-buffers))))) (defun eglot--on-shutdown (server) "Called by jsonrpc.el when SERVER is already dead." @@ -1233,7 +1235,7 @@ This docstring appeases checkdoc, that's all." :request-dispatcher (funcall spread #'eglot-handle-request) :on-shutdown #'eglot--on-shutdown initargs)) - (cancelled nil) + (canceled nil) (tag (make-symbol "connected-catch-tag"))) (when server-info (jsonrpc--debug server "Running language server: %s" @@ -1245,7 +1247,7 @@ This docstring appeases checkdoc, that's all." (setf (eglot--language-id server) language-id) (setf (eglot--inferior-process server) autostart-inferior-process) (run-hook-with-args 'eglot-server-initialized-hook server) - ;; Now start the handshake. To honour `eglot-sync-connect' + ;; Now start the handshake. To honor `eglot-sync-connect' ;; maybe-sync-maybe-async semantics we use `jsonrpc-async-request' ;; and mimic most of `jsonrpc-request'. (unwind-protect @@ -1272,7 +1274,7 @@ This docstring appeases checkdoc, that's all." :workspaceFolders (eglot-workspace-folders server)) :success-fn (eglot--lambda ((InitializeResult) capabilities serverInfo) - (unless cancelled + (unless canceled (push server (gethash project eglot--servers-by-project)) (setf (eglot--capabilities server) capabilities) @@ -1310,13 +1312,13 @@ in project `%s'." (when tag (throw tag t)))) :timeout eglot-connect-timeout :error-fn (eglot--lambda ((ResponseError) code message) - (unless cancelled + (unless canceled (jsonrpc-shutdown server) (let ((msg (format "%s: %s" code message))) (if tag (throw tag `(error . ,msg)) (eglot--error msg))))) :timeout-fn (lambda () - (unless cancelled + (unless canceled (jsonrpc-shutdown server) (let ((msg (format "Timed out after %s seconds" eglot-connect-timeout))) @@ -1333,7 +1335,7 @@ in project `%s'." (jsonrpc-name server)) nil) (_ server))) - (quit (jsonrpc-shutdown server) (setq cancelled 'quit))) + (quit (jsonrpc-shutdown server) (setq canceled 'quit))) (setq tag nil)))) (defun eglot--inferior-bootstrap (name contact &optional connect-args) @@ -1497,29 +1499,41 @@ If optional MARKER, return a marker instead" (defun eglot--path-to-uri (path) "URIfy PATH." (let ((truepath (file-truename path))) - (concat "file://" - ;; Add a leading "/" for local MS Windows-style paths. - (if (and (eq system-type 'windows-nt) - (not (file-remote-p truepath))) - "/") - (url-hexify-string - ;; Again watch out for trampy paths. - (directory-file-name (file-local-name truepath)) - eglot--uri-path-allowed-chars)))) + (if (url-type (url-generic-parse-url truepath)) + ;; Path is already a URI, so forward it to the LSP server + ;; untouched. The server should be able to handle it, since + ;; it provided this URI to clients in the first place. + truepath + (concat "file://" + ;; Add a leading "/" for local MS Windows-style paths. + (if (and (eq system-type 'windows-nt) + (not (file-remote-p truepath))) + "/") + (url-hexify-string + ;; Again watch out for trampy paths. + (directory-file-name (file-local-name truepath)) + eglot--uri-path-allowed-chars))))) (defun eglot--uri-to-path (uri) "Convert URI to file path, helped by `eglot--current-server'." (when (keywordp uri) (setq uri (substring (symbol-name uri) 1))) (let* ((server (eglot-current-server)) (remote-prefix (and server (eglot--trampish-p server))) - (retval (url-unhex-string (url-filename (url-generic-parse-url uri)))) - ;; Remove the leading "/" for local MS Windows-style paths. - (normalized (if (and (not remote-prefix) - (eq system-type 'windows-nt) - (cl-plusp (length retval))) - (substring retval 1) - retval))) - (concat remote-prefix normalized))) + (url (url-generic-parse-url uri))) + ;; Only parse file:// URIs, leave other URI untouched as + ;; `file-name-handler-alist' should know how to handle them + ;; (bug#58790). + (if (string= "file" (url-type url)) + (let* ((retval (url-unhex-string (url-filename url))) + ;; Remove the leading "/" for local MS Windows-style paths. + (normalized (if (and (not remote-prefix) + (eq system-type 'windows-nt) + (cl-plusp (length retval))) + (substring retval 1) + retval))) + (concat remote-prefix normalized)) + + uri))) (defun eglot--snippet-expansion-fn () "Compute a function to expand snippets. @@ -1660,7 +1674,7 @@ against a variable's name. Examples include the string Before Eglot starts \"managing\" a particular buffer, it opinionatedly sets some peripheral Emacs facilities, such as Flymake, Xref and Company. These overriding settings help ensure -consistent Eglot behaviour and only stay in place until +consistent Eglot behavior and only stay in place until \"managing\" stops (usually via `eglot-shutdown'), whereupon the previous settings are restored. @@ -1672,7 +1686,7 @@ For example, to keep your Company customization, add the symbol `company' to this variable.") (defun eglot--stay-out-of-p (symbol) - "Tell if Eglot should stay of of SYMBOL." + "Tell if Eglot should stay out of SYMBOL." (cl-find (symbol-name symbol) eglot-stay-out-of :test (lambda (s thing) (let ((re (if (symbolp thing) (symbol-name thing) thing))) @@ -1825,13 +1839,13 @@ If it is activated, also signal textDocument/didOpen." (call-interactively what) (force-mode-line-update t)))))) -(defun eglot-manual () "Open on-line documentation." - (interactive) (browse-url "https://github.com/joaotavora/eglot#readme")) +(defun eglot-manual () "Open documentation." + (declare (obsolete info "29.1")) + (interactive) (info "(eglot)")) (easy-menu-define eglot-menu nil "Eglot" `("Eglot" ;; Commands for getting information and customization. - ["Read manual" eglot-manual] ["Customize Eglot" (lambda () (interactive) (customize-group "eglot"))] "--" ;; xref like commands. @@ -1907,12 +1921,11 @@ Uses THING, FACE, DEFS and PREPEND." (defun eglot--mode-line-format () "Compose the Eglot's mode-line." - (pcase-let* ((server (eglot-current-server)) - (nick (and server (eglot-project-nickname server))) - (pending (and server (hash-table-count - (jsonrpc--request-continuations server)))) - (`(,_id ,doing ,done-p ,_detail) (and server (eglot--spinner server))) - (last-error (and server (jsonrpc-last-error server)))) + (let* ((server (eglot-current-server)) + (nick (and server (eglot-project-nickname server))) + (pending (and server (hash-table-count + (jsonrpc--request-continuations server)))) + (last-error (and server (jsonrpc-last-error server)))) (append `(,(propertize eglot-menu-string @@ -1938,14 +1951,11 @@ Uses THING, FACE, DEFS and PREPEND." '((mouse-3 eglot-clear-status "Clear this status")) (format "An error occurred: %s\n" (plist-get last-error :message))))) - ,@(when (and doing (not done-p)) - `("/" ,(eglot--mode-line-props doing - 'compilation-mode-line-run '()))) - ,@(when (cl-plusp pending) - `("/" ,(eglot--mode-line-props - (format "%d" pending) 'warning - '((mouse-3 eglot-forget-pending-continuations - "Forget pending continuations")) + ,@(when (cl-plusp pending) + `("/" ,(eglot--mode-line-props + (format "%d" pending) 'warning + '((mouse-3 eglot-forget-pending-continuations + "Forget pending continuations")) "Number of outgoing, \ still unanswered LSP requests to the server\n")))))))) @@ -2282,8 +2292,7 @@ Instead of a plist, an alist ((SECTION . VALUE) ...) can be used instead, but this variant is less reliable and not recommended. This variable should be set as a directory-local variable. See -See info node `(emacs)Directory Variables' for various ways to to -that. +info node `(emacs)Directory Variables' for various ways to do that. Here's an example value that establishes two sections relevant to the Pylsp and Gopls LSP servers: @@ -2352,10 +2361,11 @@ When called interactively, use the currently active server" (with-temp-buffer (let* ((uri-path (eglot--uri-to-path scopeUri)) (default-directory - (if (and (not (string-empty-p uri-path)) - (file-directory-p uri-path)) - (file-name-as-directory uri-path) - (project-root (eglot--project server))))) + (if (and uri-path + (not (string-empty-p uri-path)) + (file-directory-p uri-path)) + (file-name-as-directory uri-path) + (project-root (eglot--project server))))) (setq-local major-mode (car (eglot--major-modes server))) (hack-dir-local-variables-non-file-buffer) (cl-loop for (wsection o) @@ -2397,7 +2407,6 @@ When called interactively, use the currently active server" vconcat `[,(list :range `(:start ,beg :end ,end) :rangeLength len :text text)])))) (setq eglot--recent-changes nil) - (setf (eglot--spinner server) (list nil :textDocument/didChange t)) (jsonrpc--call-deferred server)))) (defun eglot--signal-textDocument/didOpen () @@ -2443,7 +2452,7 @@ When called interactively, use the currently active server" Calls REPORT-FN (or arranges for it to be called) when the server publishes diagnostics. Between calls to this function, REPORT-FN may be called multiple times (respecting the protocol of -`flymake-backend-functions')." +`flymake-diagnostic-functions')." (cond (eglot--managed-mode (setq eglot--current-flymake-report-fn report-fn) (eglot--report-to-flymake eglot--diagnostics)) @@ -2918,7 +2927,7 @@ for which LSP on-type-formatting should be requested." (let ((active-param (or activeParameter sig-help-active-param)) params-start params-end) ;; Ad-hoc attempt to parse label as <name>(<params>) - (when (looking-at "\\([^(]+\\)(\\([^)]+\\))") + (when (looking-at "\\([^(]*\\)(\\([^)]+\\))") (setq params-start (match-beginning 2) params-end (match-end 2)) (add-face-text-property (match-beginning 1) (match-end 1) 'font-lock-function-name-face)) @@ -3095,25 +3104,7 @@ Returns a list as described in docstring of `imenu--index-alist'." (save-excursion (save-restriction (narrow-to-region beg end) - - ;; On emacs versions < 26.2, - ;; `replace-buffer-contents' is buggy - it calls - ;; change functions with invalid arguments - so we - ;; manually call the change functions here. - ;; - ;; See emacs bugs #32237, #32278: - ;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=32237 - ;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=32278 - (let ((inhibit-modification-hooks t) - (length (- end beg)) - (beg (marker-position beg)) - (end (marker-position end))) - (run-hook-with-args 'before-change-functions - beg end) - (replace-buffer-contents temp) - (run-hook-with-args 'after-change-functions - beg (+ beg (length newText)) - length)))) + (replace-buffer-contents temp))) (progress-reporter-update reporter (cl-incf done))))))) (mapcar (eglot--lambda ((TextEdit) range newText) (cons newText (eglot--range-region range 'markers))) @@ -3142,7 +3133,7 @@ Returns a list as described in docstring of `imenu--index-alist'." (unless (y-or-n-p (format "[eglot] Server wants to edit:\n %s\n Proceed? " (mapconcat #'identity (mapcar #'car prepared) "\n "))) - (jsonrpc-error "User cancelled server edit"))) + (jsonrpc-error "User canceled server edit"))) (cl-loop for edit in prepared for (path edits version) = edit do (with-current-buffer (find-file-noselect path) @@ -3214,7 +3205,7 @@ at point. With prefix argument, prompt for ACTION-KIND." actions))) (defun eglot--read-execute-code-action (actions server &optional action-kind) - "Helper for interactive calls to `eglot-code-actions'" + "Helper for interactive calls to `eglot-code-actions'." (let* ((menu-items (or (cl-loop for a in actions collect (cons (plist-get a :title) a)) @@ -3267,8 +3258,12 @@ at point. With prefix argument, prompt for ACTION-KIND." (eglot-unregister-capability server method id) (let* (success (globs (mapcar - (eglot--lambda ((FileSystemWatcher) globPattern) - (eglot--glob-compile globPattern t t)) + (eglot--lambda ((FileSystemWatcher) globPattern kind) + (cons (eglot--glob-compile globPattern t t) + ;; the default "7" means bitwise OR of + ;; WatchKind.Create (1), WatchKind.Change + ;; (2), WatchKind.Delete (4) + (or kind 7))) watchers)) (dirs-to-watch (delete-dups (mapcar #'file-name-directory @@ -3277,17 +3272,20 @@ at point. With prefix argument, prompt for ACTION-KIND." (cl-labels ((handle-event (event) - (pcase-let ((`(,desc ,action ,file ,file1) event)) + (pcase-let* ((`(,desc ,action ,file ,file1) event) + (action-type (cl-case action + (created 1) (changed 2) (deleted 3))) + (action-bit (when action-type + (ash 1 (1- action-type))))) (cond ((and (memq action '(created changed deleted)) - (cl-find file globs :test (lambda (f g) (funcall g f)))) + (cl-loop for (glob . kind-bitmask) in globs + thereis (and (> (logand kind-bitmask action-bit) 0) + (funcall glob file)))) (jsonrpc-notify server :workspace/didChangeWatchedFiles `(:changes ,(vector `(:uri ,(eglot--path-to-uri file) - :type ,(cl-case action - (created 1) - (changed 2) - (deleted 3))))))) + :type ,action-type))))) ((eq action 'renamed) (handle-event `(,desc 'deleted ,file)) (handle-event `(,desc 'created ,file1))))))) diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 537b9484bd5..7c470de195f 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -52,7 +52,7 @@ All commands in `lisp-mode-shared-map' are inherited by this map." :parent lisp-mode-shared-map "M-TAB" #'completion-at-point "C-M-x" #'eval-defun - "C-c C-e" #'elisp-eval-buffer + "C-c C-e" #'elisp-eval-region-or-buffer "C-c C-f" #'elisp-byte-compile-file "C-c C-b" #'elisp-byte-compile-buffer "C-M-q" #'indent-pp-sexp) @@ -280,7 +280,9 @@ Comments in the form will be lost." (remove-hook 'electric-pair-mode-hook #'emacs-lisp-set-electric-text-pairs)) (defun elisp-enable-lexical-binding (&optional interactive) - "Make the current buffer use `lexical-binding'." + "Make the current buffer use `lexical-binding'. +INTERACTIVE non-nil means ask the user for confirmation; this +happens in interactive invocations." (interactive "p") (if lexical-binding (when interactive @@ -360,7 +362,7 @@ be used instead. ;;; Completion at point for Elisp (defun elisp--local-variables-1 (vars sexp) - "Return the vars locally bound around the witness, or nil if not found." + "Return VARS locally bound around the witness, or nil if not found." (let (res) (while (unless @@ -463,7 +465,7 @@ be used instead. lastvars))))) (defun elisp--expect-function-p (pos) - "Return non-nil if the symbol at point is expected to be a function." + "Return non-nil if the symbol at position POS is expected to be a function." (or (and (eq (char-before pos) ?') (eq (char-before (1- pos)) ?#)) @@ -1232,7 +1234,7 @@ All commands in `lisp-mode-shared-map' are inherited by this map." :parent lisp-mode-shared-map "C-M-x" #'eval-defun "C-M-q" #'indent-pp-sexp - "C-c C-e" #'elisp-eval-buffer + "C-c C-e" #'elisp-eval-region-or-buffer "C-c C-b" #'elisp-byte-compile-buffer "M-TAB" #'completion-at-point "C-j" #'eval-print-last-sexp) @@ -1331,12 +1333,12 @@ Semicolons start comments. (defun eval-print-last-sexp (&optional eval-last-sexp-arg-internal) "Evaluate sexp before point; print value into current buffer. +Interactively, EVAL-LAST-SEXP-ARG-INTERNAL is the prefix numeric argument. Normally, this function truncates long output according to the value of the variables `eval-expression-print-length' and -`eval-expression-print-level'. With a prefix argument of zero, -however, there is no such truncation. Such a prefix argument -also causes integers to be printed in several additional formats -\(octal, hexadecimal, and character). +`eval-expression-print-level'. But if EVAL-LAST-SEXP-ARG-INTERNAL is zero, +there is no such truncation, and integers are printed in several additional +formats (octal, hexadecimal, and character). If `eval-expression-debug-on-error' is non-nil, which is the default, this command arranges for all errors to enter the debugger." @@ -1557,8 +1559,8 @@ POS specifies the starting position where EXP was found and defaults to point." (defun eval-last-sexp (eval-last-sexp-arg-internal) "Evaluate sexp before point; print value in the echo area. -Interactively, with a non `-' prefix argument, print output into -current buffer. +Interactively, EVAL-LAST-SEXP-ARG-INTERNAL is the prefix argument. +With a non `-' prefix argument, print output into current buffer. This commands handles `defvar', `defcustom' and `defface' the same way that `eval-defun' does. See the doc string of that @@ -1588,7 +1590,7 @@ this command arranges for all errors to enter the debugger." (car value)))) (defun elisp--eval-defun-1 (form) - "Treat some expressions specially. + "Treat some expressions in FORM specially. Reset the `defvar' and `defcustom' variables to the initial value. \(For `defcustom', use the :set function if there is one.) Reinitialize the face according to the `defface' specification." @@ -1688,15 +1690,21 @@ Return the result of evaluation." elisp--eval-defun-result)) (defun eval-defun (edebug-it) - "Evaluate the top-level form containing point. + "Evaluate top-level form around point and instrument it if EDEBUG-IT is non-nil. +Interactively, EDEBUG-IT is the prefix argument. +If `edebug-all-defs' is non-nil, that inverts the meaning of EDEBUG-IT +and the prefix argument: this function will instrument the form +unless EDEBUG-IT is non-nil. The command `edebug-all-defs' toggles +the value of the variable `edebug-all-defs'. + If point isn't in a top-level form, evaluate the first top-level form after point. If there is no top-level form after point, -eval the first preceeding top-level form. +evaluate the first preceding top-level form. If the current defun is actually a call to `defvar' or `defcustom', evaluating it this way resets the variable using its initial value expression (using the defcustom's :set function if there is one), even -if the variable already has some other value. \(Normally `defvar' and +if the variable already has some other value. (Normally `defvar' and `defcustom' do not alter the value if there already is one.) In an analogous way, evaluating a `defface' overrides any customizations of the face, so that it becomes defined exactly as the `defface' expression @@ -1705,8 +1713,6 @@ says. If `eval-expression-debug-on-error' is non-nil, which is the default, this command arranges for all errors to enter the debugger. -With a prefix argument, instrument the code for Edebug. - If acting on a `defun' for FUNCTION, and the function was instrumented, `Edebug: FUNCTION' is printed in the echo area. If not instrumented, just FUNCTION is printed. @@ -1734,7 +1740,8 @@ which see." ;;; ElDoc Support (defvar elisp--eldoc-last-data (make-vector 3 nil) - "Bookkeeping; elements are as follows: + "Bookkeeping. +Elements are as follows: 0 - contains the last symbol read from the buffer. 1 - contains the string last displayed in the echo area for variables, or argument string for functions. @@ -1766,7 +1773,7 @@ it is preferable to use ElDoc's interfaces directly.") "use ElDoc's interfaces instead." "28.1") (defun elisp-eldoc-funcall (callback &rest _ignored) - "Document function call at point. + "Document function call at point by calling CALLBACK. Intended for `eldoc-documentation-functions' (which see)." (let* ((sym-info (elisp--fnsym-in-current-sexp)) (fn-sym (car sym-info))) @@ -1778,7 +1785,7 @@ Intended for `eldoc-documentation-functions' (which see)." 'font-lock-keyword-face))))) (defun elisp-eldoc-var-docstring (callback &rest _ignored) - "Document variable at point. + "Document variable at point by calling CALLBACK. Intended for `eldoc-documentation-functions' (which see). Also see `elisp-eldoc-var-docstring-with-value'." (let* ((sym (elisp--current-symbol)) @@ -1789,7 +1796,7 @@ Also see `elisp-eldoc-var-docstring-with-value'." :face 'font-lock-variable-name-face)))) (defun elisp-eldoc-var-docstring-with-value (callback &rest _) - "Document variable at point. + "Document variable at point by calling CALLBACK. Intended for `eldoc-documentation-functions' (which see). Compared to `elisp-eldoc-var-docstring', this also includes the current variable value and a bigger chunk of the docstring." @@ -1817,6 +1824,7 @@ current variable value and a bigger chunk of the docstring." (defun elisp-get-fnsym-args-string (sym &optional index) "Return a string containing the parameter list of the function SYM. +INDEX is the index of the parameter in the returned string to highlight. If SYM is a subr and no arglist is obtainable from the docstring or elsewhere, return a 1-line docstring." (let ((argstring @@ -1847,7 +1855,8 @@ or elsewhere, return a 1-line docstring." sym argstring index)))) (defun elisp--highlight-function-argument (sym args index) - "Highlight argument INDEX in ARGS list for function SYM." + "Highlight the argument of function SYM whose index is INDEX. +ARGS is the argument list of function SYM." ;; FIXME: This should probably work on the list representation of `args' ;; rather than its string representation. ;; FIXME: This function is much too long, we need to split it up! @@ -2203,11 +2212,17 @@ Runs in a batch-mode Emacs. Interactively use variable (terpri) (pp collected))) -(defun elisp-eval-buffer () - "Evaluate the forms in the current buffer." +(defun elisp-eval-region-or-buffer () + "Evaluate the forms in the active region or the whole current buffer. +In Transient Mark mode when the mark is active, call `eval-region'. +Otherwise, call `eval-buffer'." (interactive) - (eval-buffer) - (message "Evaluated the %s buffer" (buffer-name))) + (if (use-region-p) + (eval-region (region-beginning) (region-end)) + (eval-buffer)) + (message "Evaluated the %s%s buffer" + (if (use-region-p) "region in the " "") + (buffer-name))) (defun elisp-byte-compile-file (&optional load) "Byte compile the file the current buffer is visiting. diff --git a/lisp/progmodes/flymake-cc.el b/lisp/progmodes/flymake-cc.el index 49e36f42808..b44e625565e 100644 --- a/lisp/progmodes/flymake-cc.el +++ b/lisp/progmodes/flymake-cc.el @@ -114,7 +114,7 @@ process that is passed the current buffer's contents via stdin. REPORT-FN is Flymake's callback." ;; HACK: XXX: Assuming this backend function is run before it in ;; `flymake-diagnostic-functions', very hackingly convince the other - ;; backend `flymake-proc-legacy-backend', which is on by default, to + ;; backend `flymake-proc-legacy-flymake', which is on by default, to ;; disable itself. ;; (setq-local flymake-proc-allowed-file-name-masks nil) diff --git a/lisp/progmodes/flymake.el b/lisp/progmodes/flymake.el index 294cf47087c..adb984c3e59 100644 --- a/lisp/progmodes/flymake.el +++ b/lisp/progmodes/flymake.el @@ -1133,7 +1133,7 @@ special *Flymake log* buffer." :group 'flymake :lighter (add-hook 'kill-buffer-hook 'flymake-kill-buffer-hook nil t) (add-hook 'eldoc-documentation-functions 'flymake-eldoc-function t t) - ;; If Flymake happened to be already already ON, we must cleanup + ;; If Flymake happened to be already ON, we must cleanup ;; existing diagnostic overlays, lest we forget them by blindly ;; reinitializing `flymake--state' in the next line. ;; See https://github.com/joaotavora/eglot/issues/223. diff --git a/lisp/progmodes/hideshow.el b/lisp/progmodes/hideshow.el index 6de079f05a6..655dd6a5d94 100644 --- a/lisp/progmodes/hideshow.el +++ b/lisp/progmodes/hideshow.el @@ -31,14 +31,14 @@ ;; are available, implementing block hiding and showing. They (and their ;; keybindings) are: ;; -;; hs-hide-block C-c @ C-h -;; hs-show-block C-c @ C-s -;; hs-hide-all C-c @ C-M-h -;; hs-show-all C-c @ C-M-s -;; hs-hide-level C-c @ C-l -;; hs-toggle-hiding C-c @ C-c -;; hs-toggle-hiding [(shift mouse-2)] -;; hs-hide-initial-comment-block +;; `hs-hide-block' C-c @ C-h +;; `hs-show-block' C-c @ C-s +;; `hs-hide-all' C-c @ C-M-h +;; `hs-show-all' C-c @ C-M-s +;; `hs-hide-level' C-c @ C-l +;; `hs-toggle-hiding' C-c @ C-c +;; `hs-toggle-hiding' S-<mouse-2> +;; `hs-hide-initial-comment-block' ;; ;; Blocks are defined per mode. In c-mode, c++-mode and java-mode, they ;; are simply text between curly braces, while in Lisp-ish modes parens @@ -50,16 +50,14 @@ ;; * Suggested usage ;; -;; First make sure hideshow.el is in a directory in your `load-path'. -;; You can optionally byte-compile it using `M-x byte-compile-file'. -;; Then, add the following to your init file: +;; Add the following to your init file: ;; -;; (load-library "hideshow") -;; (add-hook 'X-mode-hook #'hs-minor-mode) ; other modes similarly +;; (require 'hideshow) +;; (add-hook 'X-mode-hook #'hs-minor-mode) ; other modes similarly ;; ;; where X = {emacs-lisp,c,c++,perl,...}. You can also manually toggle ;; hideshow minor mode by typing `M-x hs-minor-mode'. After hideshow is -;; activated or deactivated, `hs-minor-mode-hook' is run w/ `run-hooks'. +;; activated or deactivated, `hs-minor-mode-hook' is run with `run-hooks'. ;; ;; Additionally, Joseph Eydelnant writes: ;; I enjoy your package hideshow.el Version 5.24 2001/02/13 @@ -67,14 +65,14 @@ ;; toggle hide/show all with a single key. ;; Here are a few lines of code that lets me do just that. ;; -;; (defvar my-hs-hide nil "Current state of hideshow for toggling all.") -;; ;;;###autoload -;; (defun my-toggle-hideshow-all () "Toggle hideshow all." -;; (interactive) -;; (setq my-hs-hide (not my-hs-hide)) -;; (if my-hs-hide -;; (hs-hide-all) -;; (hs-show-all))) +;; (defvar my-hs-hide nil "Current state of hideshow for toggling all.") +;; ;;;###autoload +;; (defun my-toggle-hideshow-all () "Toggle hideshow all." +;; (interactive) +;; (setq my-hs-hide (not my-hs-hide)) +;; (if my-hs-hide +;; (hs-hide-all) +;; (hs-show-all))) ;; ;; [Your hideshow hacks here!] @@ -82,12 +80,12 @@ ;; ;; You can use `M-x customize-variable' on the following variables: ;; -;; - hs-hide-comments-when-hiding-all -- self-explanatory! -;; - hs-hide-all-non-comment-function -- if non-nil, when doing a -;; `hs-hide-all', this function -;; is called w/ no arguments -;; - hs-isearch-open -- what kind of hidden blocks to -;; open when doing isearch +;; - `hs-hide-comments-when-hiding-all' -- self-explanatory! +;; - `hs-hide-all-non-comment-function' -- if non-nil, when doing a +;; `hs-hide-all', this function +;; is called with no arguments +;; - `hs-isearch-open' -- what kind of hidden blocks to +;; open when doing isearch ;; ;; Some languages (e.g., Java) are deeply nested, so the normal behavior ;; of `hs-hide-all' (hiding all but top-level blocks) results in very @@ -96,21 +94,21 @@ ;; what is more useful. For example, the following code shows the next ;; nested level in addition to the top-level: ;; -;; (defun ttn-hs-hide-level-1 () -;; (when (hs-looking-at-block-start-p) -;; (hs-hide-level 1)) -;; (forward-sexp 1)) -;; (setq hs-hide-all-non-comment-function 'ttn-hs-hide-level-1) +;; (defun ttn-hs-hide-level-1 () +;; (when (hs-looking-at-block-start-p) +;; (hs-hide-level 1)) +;; (forward-sexp 1)) +;; (setq hs-hide-all-non-comment-function 'ttn-hs-hide-level-1) ;; -;; Hideshow works w/ incremental search (isearch) by setting the variable +;; Hideshow works with incremental search (isearch) by setting the variable ;; `hs-headline', which is the line of text at the beginning of a hidden ;; block that contains a match for the search. You can have this show up ;; in the mode line by modifying the variable `mode-line-format'. For ;; example, the following code prepends this info to the mode line: ;; -;; (unless (memq 'hs-headline mode-line-format) -;; (setq mode-line-format -;; (append '("-" hs-headline) mode-line-format))) +;; (unless (memq 'hs-headline mode-line-format) +;; (setq mode-line-format +;; (append '("-" hs-headline) mode-line-format))) ;; ;; See documentation for `mode-line-format' for more info. ;; @@ -121,8 +119,8 @@ ;; ;; One of `hs-hide-hook' or `hs-show-hook' is run for the toggling ;; commands when the result of the toggle is to hide or show blocks, -;; respectively. All hooks are run w/ `run-hooks'. See docs for each -;; variable or hook for more info. +;; respectively. All hooks are run with `run-hooks'. See the +;; documentation for each variable or hook for more information. ;; ;; Normally, hideshow tries to determine appropriate values for block ;; and comment definitions by examining the buffer's major mode. If @@ -278,7 +276,7 @@ START, END and COMMENT-START are regular expressions. A block is defined as text surrounded by START and END. As a special case, START may be a list of the form (COMPLEX-START -MDATA-SELECTOR), where COMPLEX-START is a regexp w/ multiple parts and +MDATA-SELECTOR), where COMPLEX-START is a regexp with multiple parts and MDATA-SELECTOR an integer that specifies which sub-match is the proper place to adjust point, before calling `hs-forward-sexp-func'. Point is adjusted to the beginning of the specified match. For example, @@ -348,22 +346,20 @@ info node `(elisp)Overlays'." "Non-nil if using hideshow mode as a minor mode of some other mode. Use the command `hs-minor-mode' to toggle or set this variable.") -(defvar hs-minor-mode-map - (let ((map (make-sparse-keymap))) - ;; These bindings roughly imitate those used by Outline mode. - (define-key map "\C-c@\C-h" #'hs-hide-block) - (define-key map "\C-c@\C-s" #'hs-show-block) - (define-key map "\C-c@\C-\M-h" #'hs-hide-all) - (define-key map "\C-c@\C-\M-s" #'hs-show-all) - (define-key map "\C-c@\C-l" #'hs-hide-level) - (define-key map "\C-c@\C-c" #'hs-toggle-hiding) - (define-key map "\C-c@\C-a" #'hs-show-all) - (define-key map "\C-c@\C-t" #'hs-hide-all) - (define-key map "\C-c@\C-d" #'hs-hide-block) - (define-key map "\C-c@\C-e" #'hs-toggle-hiding) - (define-key map [(shift mouse-2)] #'hs-toggle-hiding) - map) - "Keymap for hideshow minor mode.") +(defvar-keymap hs-minor-mode-map + :doc "Keymap for hideshow minor mode." + ;; These bindings roughly imitate those used by Outline mode. + "C-c @ C-h" #'hs-hide-block + "C-c @ C-s" #'hs-show-block + "C-c @ C-M-h" #'hs-hide-all + "C-c @ C-M-s" #'hs-show-all + "C-c @ C-l" #'hs-hide-level + "C-c @ C-c" #'hs-toggle-hiding + "C-c @ C-a" #'hs-show-all + "C-c @ C-t" #'hs-hide-all + "C-c @ C-d" #'hs-hide-block + "C-c @ C-e" #'hs-toggle-hiding + "S-<mouse-2>" #'hs-toggle-hiding) (easy-menu-define hs-minor-mode-menu hs-minor-mode-map "Menu used when hideshow minor mode is active." @@ -580,7 +576,7 @@ property of an overlay." (save-match-data (not (nth 8 (syntax-ppss)))))) (defun hs-forward-sexp (match-data arg) - "Adjust point based on MATCH-DATA and call `hs-forward-sexp-func' w/ ARG. + "Adjust point based on MATCH-DATA and call `hs-forward-sexp-func' with ARG. Original match data is restored upon return." (save-match-data (set-match-data match-data) diff --git a/lisp/progmodes/idlw-shell.el b/lisp/progmodes/idlw-shell.el index 63f032b7b39..20472a6034b 100644 --- a/lisp/progmodes/idlw-shell.el +++ b/lisp/progmodes/idlw-shell.el @@ -448,7 +448,7 @@ a face highlighting may be better." We use a single character by default, since the main block of IDL procedures often has no indentation. Where possible, IDLWAVE will use overlays to display the stop-lines. The arrow is only used on character-based terminals. -See also `idlwave-shell-use-overlay-arrow'." +See also `idlwave-shell-mark-stop-line'." :group 'idlwave-shell-highlighting-and-faces :type 'string) diff --git a/lisp/progmodes/mixal-mode.el b/lisp/progmodes/mixal-mode.el index 9d1ceaa55a8..358b347f6ef 100644 --- a/lisp/progmodes/mixal-mode.el +++ b/lisp/progmodes/mixal-mode.el @@ -33,9 +33,6 @@ ;; GNU MDK from `https://savannah.gnu.org/projects/mdk/' and ;; `https://ftp.gnu.org/pub/gnu/mdk'. ;; -;; To use this mode, place the following in your init file: -;; `(load-file "/PATH-TO-FILE/mixal-mode.el")'. -;; ;; When you load a file with the extension .mixal the mode will be started ;; automatically. If you want to start the mode manually, use `M-x mixal-mode'. ;; Font locking will work, the behavior of tabs is the same as Emacs's diff --git a/lisp/progmodes/perl-mode.el b/lisp/progmodes/perl-mode.el index db9df672797..4dd0fd67a6b 100644 --- a/lisp/progmodes/perl-mode.el +++ b/lisp/progmodes/perl-mode.el @@ -27,8 +27,8 @@ ;;; Commentary: -;; To enter perl-mode automatically, add (autoload 'perl-mode "perl-mode") -;; to your init file and change the first line of your perl script to: +;; To enter `perl-mode' automatically, change the first line of your +;; perl script to: ;; #!/usr/bin/perl -- # -*-Perl-*- ;; With arguments to perl: ;; #!/usr/bin/perl -P- # -*-Perl-*- diff --git a/lisp/progmodes/prog-mode.el b/lisp/progmodes/prog-mode.el index f87230bd2f5..58cb48f1829 100644 --- a/lisp/progmodes/prog-mode.el +++ b/lisp/progmodes/prog-mode.el @@ -155,7 +155,7 @@ which case it will be used to compose the new symbol as per the third argument of `compose-region'.") (defun prettify-symbols-default-compose-p (start end _match) - "Return non-nil iff the symbol MATCH should be composed. + "Return non-nil if the symbol MATCH should be composed. The symbol starts at position START and ends at position END. This is the default for `prettify-symbols-compose-predicate' which is suitable for most programming languages such as C or Lisp." diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el index fc035675cec..63510e90502 100644 --- a/lisp/progmodes/project.el +++ b/lisp/progmodes/project.el @@ -1,7 +1,7 @@ ;;; project.el --- Operations on the current project -*- lexical-binding: t; -*- ;; Copyright (C) 2015-2022 Free Software Foundation, Inc. -;; Version: 0.8.2 +;; Version: 0.8.3 ;; Package-Requires: ((emacs "26.1") (xref "1.4.0")) ;; This is a GNU ELPA :core package. Avoid using functionality that @@ -296,7 +296,6 @@ to find the list of ignores for each directory." (defun project--files-in-directory (dir ignores &optional files) (require 'find-dired) (require 'xref) - (defvar find-name-arg) (let* ((default-directory dir) ;; Make sure ~/ etc. in local directory name is ;; expanded and not left for the shell command @@ -308,11 +307,11 @@ to find the list of ignores for each directory." (xref--find-ignores-arguments ignores "./") (if files (concat (shell-quote-argument "(") - " " find-name-arg " " + " -name " (mapconcat #'shell-quote-argument (split-string files) - (concat " -o " find-name-arg " ")) + (concat " -o -name ")) " " (shell-quote-argument ")")) ""))) @@ -713,6 +712,7 @@ DIRS must contain directory names." (define-key map "G" 'project-or-external-find-regexp) (define-key map "r" 'project-query-replace-regexp) (define-key map "x" 'project-execute-extended-command) + (define-key map "\C-b" 'project-list-buffers) map) "Keymap for project commands.") @@ -1223,6 +1223,28 @@ displayed." (interactive (list (project--read-project-buffer))) (display-buffer-other-frame buffer-or-name)) +;;;###autoload +(defun project-list-buffers (&optional arg) + "Display a list of project buffers. +The list is displayed in a buffer named \"*Buffer List*\". + +By default, all project buffers are listed except those whose names +start with a space (which are for internal use). With prefix argument +ARG, show only buffers that are visiting files." + (interactive "P") + (let ((pr (project-current t))) + (display-buffer + (if (version< emacs-version "29.0.50") + (let ((buf (list-buffers-noselect arg (project-buffers pr)))) + (with-current-buffer buf + (setq-local revert-buffer-function + (lambda (&rest _ignored) + (list-buffers--refresh (project-buffers pr)) + (tabulated-list-print t)))) + buf) + (list-buffers-noselect + arg nil (lambda (buf) (memq buf (project-buffers pr)))))))) + (defcustom project-kill-buffer-conditions '(buffer-file-name ; All file-visiting buffers are included. ;; Most of temp and logging buffers (aside from hidden ones): @@ -1283,21 +1305,6 @@ Used by `project-kill-buffers'." :package-version '(project . "0.8.2") :safe #'booleanp) -(defun project--buffer-list (pr) - "Return the list of all buffers in project PR." - (let ((conn (file-remote-p (project-root pr))) - bufs) - (dolist (buf (buffer-list)) - ;; For now we go with the assumption that a project must reside - ;; entirely on one host. We might relax that in the future. - (when (and (equal conn - (file-remote-p (buffer-local-value 'default-directory buf))) - (equal pr - (with-current-buffer buf - (project-current)))) - (push buf bufs))) - (nreverse bufs))) - (defun project--buffer-check (buf conditions) "Check if buffer BUF matches any element of the list CONDITIONS. See `project-kill-buffer-conditions' or diff --git a/lisp/progmodes/python.el b/lisp/progmodes/python.el index cec0d54a447..a734e06149e 100644 --- a/lisp/progmodes/python.el +++ b/lisp/progmodes/python.el @@ -5377,6 +5377,7 @@ likely an invalid python file." ;; block and the current line, otherwise it ;; is not an opening block. (save-excursion + (python-nav-end-of-statement) (forward-line) (let ((no-back-indent t)) (save-match-data diff --git a/lisp/progmodes/sh-script.el b/lisp/progmodes/sh-script.el index 558b62b20ae..4deb06bde4b 100644 --- a/lisp/progmodes/sh-script.el +++ b/lisp/progmodes/sh-script.el @@ -522,7 +522,7 @@ This is buffer-local in every such buffer.") (rc . "\\<\\([[:alnum:]_*]+\\)[ \t]*=") (sh . "\\<\\([[:alnum:]_]+\\)=")) "Regexp for the variable name and what may follow in an assignment. -First grouping matches the variable name. This is upto and including the `=' +First grouping matches the variable name. This is up to and including the `=' sign. See `sh-feature'." :type '(repeat (cons (symbol :tag "Shell") (choice regexp diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el index 4121e4dc3cd..e585799dc63 100644 --- a/lisp/progmodes/sql.el +++ b/lisp/progmodes/sql.el @@ -781,7 +781,7 @@ host key." ;; Perform search (dolist (s (auth-source-search :max 1000)) (when (and - ;; Is PRODUCT specified, in the enty, and they are equal + ;; Is PRODUCT specified, in the entry, and they are equal (if product (if (plist-member s :product) (equal (plist-get s :product) product) @@ -1358,37 +1358,33 @@ specified, it's `sql-product' or `sql-connection' must match." ;; Keymap for sql-interactive-mode. -(defvar sql-interactive-mode-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map comint-mode-map) - (define-key map (kbd "C-j") 'sql-accumulate-and-indent) - (define-key map (kbd "C-c C-w") 'sql-copy-column) - (define-key map (kbd "O") 'sql-magic-go) - (define-key map (kbd "o") 'sql-magic-go) - (define-key map (kbd ";") 'sql-magic-semicolon) - (define-key map (kbd "C-c C-l a") 'sql-list-all) - (define-key map (kbd "C-c C-l t") 'sql-list-table) - map) - "Mode map used for `sql-interactive-mode'. -Based on `comint-mode-map'.") +(defvar-keymap sql-interactive-mode-map + :doc "Mode map used for `sql-interactive-mode'. +Based on `comint-mode-map'." + :parent comint-mode-map + "C-j" #'sql-accumulate-and-indent + "C-c C-w" #'sql-copy-column + "O" #'sql-magic-go + "o" #'sql-magic-go + ";" #'sql-magic-semicolon + "C-c C-l a" #'sql-list-all + "C-c C-l t" #'sql-list-table) ;; Keymap for sql-mode. -(defvar sql-mode-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "C-c C-c") 'sql-send-paragraph) - (define-key map (kbd "C-c C-r") 'sql-send-region) - (define-key map (kbd "C-c C-s") 'sql-send-string) - (define-key map (kbd "C-c C-b") 'sql-send-buffer) - (define-key map (kbd "C-c C-n") 'sql-send-line-and-next) - (define-key map (kbd "C-c C-i") 'sql-product-interactive) - (define-key map (kbd "C-c C-z") 'sql-show-sqli-buffer) - (define-key map (kbd "C-c C-l a") 'sql-list-all) - (define-key map (kbd "C-c C-l t") 'sql-list-table) - (define-key map [remap beginning-of-defun] 'sql-beginning-of-statement) - (define-key map [remap end-of-defun] 'sql-end-of-statement) - map) - "Mode map used for `sql-mode'.") +(defvar-keymap sql-mode-map + :doc "Mode map used for `sql-mode'." + "C-c C-c" #'sql-send-paragraph + "C-c C-r" #'sql-send-region + "C-c C-s" #'sql-send-string + "C-c C-b" #'sql-send-buffer + "C-c C-n" #'sql-send-line-and-next + "C-c C-i" #'sql-product-interactive + "C-c C-z" #'sql-show-sqli-buffer + "C-c C-l a" #'sql-list-all + "C-c C-l t" #'sql-list-table + "<remap> <beginning-of-defun>" #'sql-beginning-of-statement + "<remap> <end-of-defun>" #'sql-end-of-statement) ;; easy menu for sql-mode. diff --git a/lisp/progmodes/verilog-mode.el b/lisp/progmodes/verilog-mode.el index 310a9be4f6e..e5458e6a07f 100644 --- a/lisp/progmodes/verilog-mode.el +++ b/lisp/progmodes/verilog-mode.el @@ -7719,7 +7719,7 @@ nil otherwise." (setq match t) (setq elm nil)) (setq elm (cdr elm))))) - ;; If this is a test just for exact match, return nil ot t + ;; If this is a test just for exact match, return nil or t (if (and (equal flag 'lambda) (not (equal match 't))) nil match)))) diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index bb36688ef85..89a090ae932 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -1237,16 +1237,21 @@ local keymap that binds `RET' to `xref-quit-and-goto-xref'." (max-height (/ (window-height) 2)) (size-fun (lambda (window) (fit-window-to-buffer window max-height))) + xref-alist buf) (cond ((not (cdr xrefs)) (xref-pop-to-location (car xrefs) (assoc-default 'display-action alist))) (t + ;; Call it here because it can call (project-current), and that + ;; might depend on individual buffer, not just directory. + (setq xref-alist (xref--analyze xrefs)) + (with-current-buffer (get-buffer-create xref-buffer-name) (xref--ensure-default-directory dd (current-buffer)) (xref--transient-buffer-mode) - (xref--show-common-initialize (xref--analyze xrefs) fetcher alist) + (xref--show-common-initialize xref-alist fetcher alist) (pop-to-buffer (current-buffer) `(display-buffer-in-direction . ((direction . below) (window-height . ,size-fun)))) diff --git a/lisp/repeat.el b/lisp/repeat.el index 0ae68d6024d..33e8d98ce33 100644 --- a/lisp/repeat.el +++ b/lisp/repeat.el @@ -582,28 +582,57 @@ Used in `repeat-mode'." (push s (alist-get (get s 'repeat-map) keymaps))))) (with-help-window (help-buffer) (with-current-buffer standard-output - (insert "A list of keymaps used by commands with the symbol property `repeat-map'.\n\n") + (insert "A list of keymaps used by commands with the symbol property `repeat-map'.\n") (dolist (keymap (sort keymaps (lambda (a b) (when (and (symbolp (car a)) (symbolp (car b))) - (string-lessp (car a) (car b)))))) - (insert (format-message - "`%s' keymap is repeatable by these commands:\n" - (car keymap))) - (dolist (command (sort (cdr keymap) #'string-lessp)) - (let* ((info (help-fns--analyze-function command)) - (map (list (if (symbolp (car keymap)) - (symbol-value (car keymap)) - (car keymap)))) - (desc (mapconcat (lambda (key) - (propertize (key-description key) - 'face 'help-key-binding)) - (or (where-is-internal command map) - (where-is-internal (nth 3 info) map)) - ", "))) - (insert (format-message " `%s' (bound to %s)\n" command desc)))) - (insert "\n"))))))) + (string< (car a) (car b)))))) + (insert (format-message "\f\n* `%s'\n" (car keymap))) + (when (symbolp (car keymap)) + (insert (substitute-command-keys (format-message "\\{%s}" (car keymap))))) + + (let* ((map (if (symbolp (car keymap)) + (symbol-value (car keymap)) + (car keymap))) + (repeat-commands (cdr keymap)) + map-commands commands-enter commands-exit) + (map-keymap (lambda (_key cmd) + (when (symbolp cmd) (push cmd map-commands))) + map) + (setq map-commands (seq-uniq map-commands)) + (setq commands-enter (seq-difference repeat-commands map-commands)) + (setq commands-exit (seq-difference map-commands repeat-commands)) + + (when (or commands-enter commands-exit) + (when commands-enter + (insert "\n** Entered with:\n\n") + (fill-region-as-paragraph + (point) + (progn + (insert (mapconcat (lambda (cmd) + (format-message "`%s'" cmd)) + (sort commands-enter #'string<) + ", ")) + (point))) + (insert "\n")) + (when commands-exit + (insert "\n** Exited with:\n\n") + (fill-region-as-paragraph + (point) + (progn + (insert (mapconcat (lambda (cmd) + (format-message "`%s'" cmd)) + (sort commands-exit #'string<) + ", ")) + (point))) + (insert "\n"))))) + + ;; Hide ^Ls. + (goto-char (point-min)) + (while (search-forward "\n\f\n" nil t) + (put-text-property (1+ (match-beginning 0)) (1- (match-end 0)) + 'invisible t))))))) (provide 'repeat) diff --git a/lisp/replace.el b/lisp/replace.el index 8f81ec33a6e..c7ae77d128b 100644 --- a/lisp/replace.el +++ b/lisp/replace.el @@ -2818,7 +2818,7 @@ see the documentation of `replace-match' to find out how to simulate `case-replace'. This function returns nil if there were no matches to make, or -the user cancelled the call. +the user canceled the call. REPLACEMENTS is either a string, a list of strings, or a cons cell containing a function and its first argument. The function is diff --git a/lisp/savehist.el b/lisp/savehist.el index 8924c8dde23..f1d3e50d941 100644 --- a/lisp/savehist.el +++ b/lisp/savehist.el @@ -1,6 +1,6 @@ ;;; savehist.el --- Save minibuffer history -*- lexical-binding:t -*- -;; Copyright (C) 1997, 2005-2022 Free Software Foundation, Inc. +;; Copyright (C) 1997-2022 Free Software Foundation, Inc. ;; Author: Hrvoje Nikšić <hrvoje.niksic@avl.com> ;; Maintainer: emacs-devel@gnu.org @@ -41,10 +41,6 @@ ;; You can also explicitly save history with `M-x savehist-save' and ;; load it by loading the `savehist-file' with `M-x load-file'. -;; If you are using a version of Emacs that does not ship with this -;; package, be sure to have `savehist.el' in a directory that is in -;; your load-path, and to byte-compile it. - ;;; Code: ;; User variables diff --git a/lisp/scroll-bar.el b/lisp/scroll-bar.el index 5786a21e88e..dbe2b6241ff 100644 --- a/lisp/scroll-bar.el +++ b/lisp/scroll-bar.el @@ -390,7 +390,7 @@ EVENT should be a scroll bar click." (setq point-before-scroll before-scroll))))) -;;; Tookit scroll bars. +;;; Toolkit scroll bars. (defun scroll-bar-toolkit-scroll (event) "Handle event EVENT on vertical scroll bar." diff --git a/lisp/server.el b/lisp/server.el index 90d97c1538e..2973b783e64 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -670,7 +670,6 @@ the `server-process' variable." "/tmp/") (ignore-errors (delete-directory (file-name-directory server-file)))))) - (setq server-mode nil) ;; already set by the minor mode code (display-warning 'server (concat "Unable to start the Emacs server.\n" @@ -688,7 +687,9 @@ server or call `\\[server-force-delete]' to forcibly disconnect it.")) (if leave-dead (progn (unless (eq t leave-dead) (server-log (message "Server stopped"))) - (setq server-process nil)) + (setq server-mode nil + global-minor-modes (delq 'server-mode global-minor-modes) + server-process nil)) ;; Make sure there is a safe directory in which to place the socket. (server-ensure-safe-dir server-dir) (when server-process @@ -716,7 +717,10 @@ server or call `\\[server-force-delete]' to forcibly disconnect it.")) ;; Those are decoded by server-process-filter according ;; to file-name-coding-system. Also don't get ;; confused by CRs since we don't quote them. - :coding 'raw-text-unix + ;; For encoding, we must use the locale's encoding, + ;; since emacsclient shows that verbatim on the + ;; console. + :coding (cons 'raw-text-unix locale-coding-system) ;; The other args depend on the kind of socket used. (if server-use-tcp (list :family 'ipv4 ;; We're not ready for IPv6 yet @@ -728,6 +732,8 @@ server or call `\\[server-force-delete]' to forcibly disconnect it.")) :plist '(:authenticated t))))) (unless server-process (error "Could not start server process")) (process-put server-process :server-file server-file) + (setq server-mode t) + (push 'server-mode global-minor-modes) (when server-use-tcp (let ((auth-key (server-get-auth-key))) (process-put server-process :auth-key auth-key) @@ -796,6 +802,10 @@ by the current Emacs process, use the `server-process' variable." t) (file-error nil))) +;; This keymap is empty, but allows users to define keybindings to use +;; when `server-mode' is active. +(defvar-keymap server-mode-map) + ;;;###autoload (define-minor-mode server-mode "Toggle Server mode. @@ -805,6 +815,7 @@ Server mode runs a process that accepts commands from the `server-start' for details." :global t :version "22.1" + :keymap server-mode-map ;; Fixme: Should this check for an existing server socket and do ;; nothing if there is one (for multiple Emacs sessions)? (server-start (not server-mode))) diff --git a/lisp/shell.el b/lisp/shell.el index 641f274045d..7c3c925ab87 100644 --- a/lisp/shell.el +++ b/lisp/shell.el @@ -393,6 +393,14 @@ Useful for shells like zsh that has this feature." 'complete-expand) map)) +(defvar-keymap shell-repeat-map + :doc "Keymap to repeat shell key sequences. Used in `repeat-mode'." + "C-f" #'shell-forward-command + "C-b" #'shell-backward-command) + +(put #'shell-forward-command 'repeat-map 'shell-repeat-map) +(put #'shell-backward-command 'repeat-map 'shell-repeat-map) + (defcustom shell-mode-hook '() "Hook for customizing Shell mode." :type 'hook diff --git a/lisp/simple.el b/lisp/simple.el index 5f676ea50de..0f44b14948c 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -2491,9 +2491,15 @@ Also see `suggest-key-bindings'." (defvar execute-extended-command--binding-timer nil) +(defun execute-extended-command--describe-binding-msg (function binding shorter) + (format-message "You can run the command `%s' with %s" + function + (propertize (cond (shorter (concat "M-x " shorter)) + ((stringp binding) binding) + (t (key-description binding))) + 'face 'help-key-binding))) + (defun execute-extended-command (prefixarg &optional command-name typed) - ;; Based on Fexecute_extended_command in keyboard.c of Emacs. - ;; Aaron S. Hawley <aaron.s.hawley(at)gmail.com> 2009-08-24 "Read a command name, then read the arguments and call the command. To pass a prefix argument to the command you are invoking, give a prefix argument to `execute-extended-command'." @@ -2516,7 +2522,7 @@ invoking, give a prefix argument to `execute-extended-command'." (not executing-kbd-macro) (where-is-internal function overriding-local-map t))) (delay-before-suggest 0) - (find-shorter nil)) + find-shorter shorter) (unless (commandp function) (error "`%s' is not a valid command name" command-name)) ;; If we're executing a command that's remapped, we can't actually @@ -2540,11 +2546,11 @@ invoking, give a prefix argument to `execute-extended-command'." ;; flight. (when execute-extended-command--binding-timer (cancel-timer execute-extended-command--binding-timer)) - ;; If this command displayed something in the echo area, then - ;; postpone the display of our suggestion message a bit. (when (and suggest-key-bindings (or binding (and extended-command-suggest-shorter typed))) + ;; If this command displayed something in the echo area, then + ;; postpone the display of our suggestion message a bit. (setq delay-before-suggest (cond ((zerop (length (current-message))) 0) @@ -2556,7 +2562,7 @@ invoking, give a prefix argument to `execute-extended-command'." (symbolp function) (> (length (symbol-name function)) 2)) ;; There's no binding for CMD. Let's try and find the shortest - ;; string to use in M-x. + ;; string to use in M-x. But don't actually do anything yet. (setq find-shorter t)) (when (or binding find-shorter) (setq execute-extended-command--binding-timer @@ -2570,15 +2576,12 @@ invoking, give a prefix argument to `execute-extended-command'." (when find-shorter (while-no-input ;; FIXME: Can be slow. Cache it maybe? - (setq binding (execute-extended-command--shorter + (setq shorter (execute-extended-command--shorter (symbol-name function) typed)))) - (when binding + (when (or binding shorter) (with-temp-message - (format-message "You can run the command `%s' with %s" - function - (if (stringp binding) - (concat "M-x " binding " RET") - (key-description binding))) + (execute-extended-command--describe-binding-msg + function binding shorter) (sit-for (if (numberp suggest-key-bindings) suggest-key-bindings 2)))))))))))) diff --git a/lisp/so-long.el b/lisp/so-long.el index 75201fefcad..661f5ee57a9 100644 --- a/lisp/so-long.el +++ b/lisp/so-long.el @@ -839,7 +839,7 @@ was established." ) ;; It's not clear to me whether all of these would be problematic, but they ;; seemed like reasonable targets. Some are certainly excessive in smaller - ;; buffers of minified code, but we should be aiming to maximise performance + ;; buffers of minified code, but we should be aiming to maximize performance ;; by default, so that Emacs is as responsive as we can manage in even very ;; large buffers of minified code. "List of buffer-local minor modes to explicitly disable. @@ -880,7 +880,7 @@ If `so-long-revert' is subsequently invoked, then the variables are restored to their original states. The combination of `line-move-visual' (enabled) and `truncate-lines' (disabled) -is important for maximising responsiveness when moving vertically within an +is important for maximizing responsiveness when moving vertically within an extremely long line, as otherwise the full length of the line may need to be scanned to find the next position. diff --git a/lisp/startup.el b/lisp/startup.el index 90f35491797..3745dac0c66 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -1063,19 +1063,30 @@ init-file, or to a default value if loading is not possible." ;; If we loaded a compiled file, set `user-init-file' to ;; the source version if that exists. - (when (equal (file-name-extension user-init-file) - "elc") - (let* ((source (file-name-sans-extension user-init-file)) - (alt (concat source ".el"))) - (setq source (cond ((file-exists-p alt) alt) - ((file-exists-p source) source) - (t nil))) - (when source - (when (file-newer-than-file-p source user-init-file) - (message "Warning: %s is newer than %s" - source user-init-file) - (sit-for 1)) - (setq user-init-file source)))) + (if (equal (file-name-extension user-init-file) "elc") + (let* ((source (file-name-sans-extension user-init-file)) + (alt (concat source ".el"))) + (setq source (cond ((file-exists-p alt) alt) + ((file-exists-p source) source) + (t nil))) + (when source + (when (file-newer-than-file-p source user-init-file) + (message "Warning: %s is newer than %s" + source user-init-file) + (sit-for 1)) + (setq user-init-file source))) + ;; Else, perhaps the user init file was compiled + (when (and (equal (file-name-extension user-init-file) "eln") + ;; The next test is for builds without native + ;; compilation support or builds with unexec. + (boundp 'comp-eln-to-el-h)) + (if-let (source (gethash (file-name-nondirectory user-init-file) + comp-eln-to-el-h)) + ;; source exists or the .eln file would not load + (setq user-init-file source) + (message "Warning: unknown source file for init file %S" + user-init-file) + (sit-for 1)))) (when (and load-defaults (not inhibit-default-init)) diff --git a/lisp/subr.el b/lisp/subr.el index 6b83196d05b..261ec512d89 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2584,7 +2584,7 @@ Uses the `derived-mode-parent' property of the symbol to trace backwards." (defun major-mode-restore (&optional avoided-modes) "Restore major mode earlier suspended with `major-mode-suspend'. If there was no earlier suspended major mode, then fallback to `normal-mode', -tho trying to avoid AVOIDED-MODES." +though trying to avoid AVOIDED-MODES." (if major-mode--suspended (funcall (prog1 major-mode--suspended (kill-local-variable 'major-mode--suspended))) @@ -6911,7 +6911,7 @@ string will be displayed only if BODY takes longer than TIMEOUT seconds. If FUNC is a function alias, return the function alias chain. If the function alias chain contains loops, an error will be -signalled. If NOERROR, the non-loop parts of the chain is returned." +signaled. If NOERROR, the non-loop parts of the chain is returned." (declare (side-effect-free t)) (let ((chain nil) (orig-func func)) @@ -7061,7 +7061,7 @@ CONDITION is either: (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 +See `buffer-match-p' 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 diff --git a/lisp/tab-bar.el b/lisp/tab-bar.el index cdea856ac23..eb4cec48619 100644 --- a/lisp/tab-bar.el +++ b/lisp/tab-bar.el @@ -933,7 +933,9 @@ 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 (string-pixel-width (propertize rest 'face 'tab-bar))) + (hpos (progn + (add-face-text-property 0 (length rest) 'tab-bar t rest) + (string-pixel-width rest))) (str (propertize " " 'display `(space :align-to (- right (,hpos)))))) `((align-right menu-item ,str ignore)))) @@ -1048,9 +1050,9 @@ tab bar might wrap to the second line when it shouldn't.") (unless (eq (nth 0 item) 'align-right) (setq non-tabs (concat non-tabs (nth 2 item))))))) (when tabs - (setq width (/ (- (frame-pixel-width) - (string-pixel-width - (propertize non-tabs 'face 'tab-bar))) + (add-face-text-property 0 (length non-tabs) 'tab-bar t non-tabs) + (setq width (/ (- (frame-inner-width) + (string-pixel-width non-tabs)) (length tabs))) (when tab-bar-auto-width-min (setq width (max width (if window-system @@ -1062,33 +1064,45 @@ tab bar might wrap to the second line when it shouldn't.") (nth 1 tab-bar-auto-width-max))))) (dolist (item tabs) (setf (nth 2 item) - (with-memoization (gethash (cons width (nth 2 item)) + (with-memoization (gethash (list (selected-frame) + width (nth 2 item)) tab-bar--fixed-width-hash) (let* ((name (nth 2 item)) (len (length name)) (close-p (get-text-property (1- len) 'close-tab name)) - (pixel-width (string-pixel-width - (propertize name 'face 'tab-bar-tab)))) + (continue t) + (prev-width (string-pixel-width name)) + curr-width) (cond - ((< pixel-width width) - (let* ((space (apply 'propertize " " (text-properties-at 0 name))) - (space-width (string-pixel-width (propertize space 'face 'tab-bar))) - (ins-pos (- len (if close-p 1 0)))) - (while (<= (+ pixel-width space-width) width) + ((< prev-width width) + (let* ((space (apply 'propertize " " + (text-properties-at 0 name))) + (ins-pos (- len (if close-p 1 0))) + (prev-name name)) + (while continue (setf (substring name ins-pos ins-pos) space) - (setq pixel-width (string-pixel-width - (propertize name 'face 'tab-bar-tab)))))) - ((> pixel-width width) - (let (del-pos) - (while (> pixel-width width) - (setq len (length name) - del-pos (- len (if close-p 1 0))) - (setf (substring name (1- del-pos) del-pos) "") - (setq pixel-width (string-pixel-width - (propertize name 'face 'tab-bar-tab)))) - (add-face-text-property (max (- del-pos 3) 1) - (1- del-pos) - 'shadow nil name)))) + (setq curr-width (string-pixel-width name)) + (if (and (< curr-width width) + (not (eq curr-width prev-width))) + (setq prev-width curr-width + prev-name name) + ;; Set back a shorter name + (setq name prev-name + continue nil))))) + ((> prev-width width) + (let ((del-pos1 (if close-p -2 -1)) + (del-pos2 (if close-p -1 nil))) + (while continue + (setf (substring name del-pos1 del-pos2) "") + (setq curr-width (string-pixel-width name)) + (if (and (> curr-width width) + (not (eq curr-width prev-width))) + (setq prev-width curr-width) + (setq continue nil))) + (let* ((len (length name)) + (pos (- len (if close-p 1 0)))) + (add-face-text-property + (max 0 (- pos 2)) (max 0 pos) 'shadow nil name))))) name))))) items)) @@ -2334,7 +2348,7 @@ with those specified by the selected window configuration." ((framep all-frames) (list all-frames)) (t (list (selected-frame))))) -(defun tab-bar-get-buffer-tab (buffer-or-name &optional all-frames ignore-current-tab) +(defun tab-bar-get-buffer-tab (buffer-or-name &optional all-frames ignore-current-tab all-tabs) "Return the tab that owns the window whose buffer is BUFFER-OR-NAME. BUFFER-OR-NAME may be a buffer or a buffer name, and defaults to the current buffer. @@ -2352,14 +2366,20 @@ selected frame and no others. When the optional argument IGNORE-CURRENT-TAB is non-nil, don't take into account the buffers in the currently selected tab. -Otherwise, prefer buffers of the current tab." +Otherwise, prefer buffers of the current tab. + +When the optional argument ALL-TABS is non-nil, return a list of all tabs +that contain the buffer BUFFER-OR-NAME." (let ((buffer (if buffer-or-name (get-buffer buffer-or-name) - (current-buffer)))) + (current-buffer))) + buffer-tabs) (when (bufferp buffer) - (seq-some + (funcall + (if all-tabs #'seq-each #'seq-some) (lambda (frame) - (seq-some + (funcall + (if all-tabs #'seq-each #'seq-some) (lambda (tab) (when (if (eq (car tab) 'current-tab) (get-buffer-window buffer frame) @@ -2371,8 +2391,9 @@ Otherwise, prefer buffers of the current tab." (memq buffer buffers) ;; writable window-state (member (buffer-name buffer) buffers)))) - (append tab `((index . ,(tab-bar--tab-index tab nil frame)) - (frame . ,frame))))) + (push (append tab `((index . ,(tab-bar--tab-index tab nil frame)) + (frame . ,frame))) + buffer-tabs))) (let* ((tabs (funcall tab-bar-tabs-function frame)) (current-tab (tab-bar--current-tab-find tabs))) (setq tabs (remq current-tab tabs)) @@ -2381,7 +2402,8 @@ Otherwise, prefer buffers of the current tab." tabs ;; Make sure current-tab is at the beginning of tabs. (cons current-tab tabs))))) - (tab-bar--reusable-frames all-frames))))) + (tab-bar--reusable-frames all-frames)) + (if all-tabs (nreverse buffer-tabs) (car (last buffer-tabs)))))) (defun display-buffer-in-tab (buffer alist) "Display BUFFER in a tab using display actions in ALIST. diff --git a/lisp/tab-line.el b/lisp/tab-line.el index e5e5b7b2ec7..99a785ee3e3 100644 --- a/lisp/tab-line.el +++ b/lisp/tab-line.el @@ -585,8 +585,8 @@ For use in `tab-line-tab-face-functions'." (defvar tab-line-cache-key-function #'tab-line-cache-key-default "Function that adds more cache keys. -It has one argument with a list of tabs, and returns a list of cache keys. -You can use `add-function' to add more cache keys.") +It is called with one argument, a list of tabs, and should return a list +of cache keys. You can use `add-function' to add more cache keys.") (defun tab-line-format () "Format for displaying the tab line of the selected window." diff --git a/lisp/term/pgtk-win.el b/lisp/term/pgtk-win.el index 20f15739167..a398bb9fb22 100644 --- a/lisp/term/pgtk-win.el +++ b/lisp/term/pgtk-win.el @@ -184,7 +184,7 @@ DISPLAY is the name of the display Emacs should connect to." (defun pgtk-preedit-text (event) "An internal function to display preedit text from input method. -EVENT is a `preedit-text-event'." +EVENT is a `preedit-text' event." (interactive "e") (when pgtk-preedit-overlay (delete-overlay pgtk-preedit-overlay)) diff --git a/lisp/textmodes/reftex-cite.el b/lisp/textmodes/reftex-cite.el index f3f95627af1..41a5b52f993 100644 --- a/lisp/textmodes/reftex-cite.el +++ b/lisp/textmodes/reftex-cite.el @@ -96,7 +96,7 @@ Find the bof of the current file." "Return list of bibfiles for current document. When using the chapterbib or bibunits package you should either use the same database files everywhere, or separate parts using -different databases into different files (included into the mater file). +different databases into different files (included into the master file). Then this function will return the applicable database files." ;; Ensure access to scanning info diff --git a/lisp/textmodes/reftex-index.el b/lisp/textmodes/reftex-index.el index 075ad666b3d..38d6ebe7e6f 100644 --- a/lisp/textmodes/reftex-index.el +++ b/lisp/textmodes/reftex-index.el @@ -1807,7 +1807,7 @@ With optional arg ALLOW-NEWLINE, allow single newline between words." (defun reftex-index-phrases-find-dup-re (phrase &optional sub) "Return a regexp which matches variations of PHRASE (with additional space). When SUB ins non-nil, the regexp will also match when PHRASE is a subphrase -of another phrase. The regexp works lonly in the phrase buffer." +of another phrase. The regexp works only in the phrase buffer." (concat (if sub "^\\S-?\t\\([^\t\n]*" "^\\S-?\t") (mapconcat #'regexp-quote (split-string phrase) " +") (if sub "[^\t\n]*\\)\\([\t\n]\\|$\\)" " *\\([\t\n]\\|$\\)"))) diff --git a/lisp/textmodes/table.el b/lisp/textmodes/table.el index f81cedc39bc..2f34a58b5bc 100644 --- a/lisp/textmodes/table.el +++ b/lisp/textmodes/table.el @@ -125,9 +125,7 @@ ;; are tired of guessing how it works come back to this document ;; again. ;; -;; To use the package regularly place this file in the site library -;; directory and add the next expression in your init file. Make -;; sure that directory is included in the `load-path'. +;; To use the package regularly, add this to your init file: ;; ;; (require 'table) ;; diff --git a/lisp/textmodes/tex-mode.el b/lisp/textmodes/tex-mode.el index ca0312d8fb0..a1914a8cc82 100644 --- a/lisp/textmodes/tex-mode.el +++ b/lisp/textmodes/tex-mode.el @@ -2238,7 +2238,7 @@ of the current buffer." "&"))) (defun tex-uptodate-p (file) - "Return non-nil if FILE is not uptodate w.r.t the document source files. + "Return non-nil if FILE is not up-to-date w.r.t the document source files. FILE is typically the output DVI or PDF file." ;; We should check all the files included !!! (and @@ -2375,7 +2375,7 @@ Only applies the FSPEC to the args part of FORMAT." (push cmd tmp))) ;; Only remove if there's something left. (if tmp (setq cmds (nreverse tmp)))) - ;; Remove commands whose input is not uptodate either. + ;; Remove commands whose input is not up-to-date either. (let ((outs (delq nil (mapcar (lambda (x) (nth 2 x)) cmds))) (tmp nil)) (dolist (cmd cmds) diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el index 462f87d3c1a..9dda3e1fcb2 100644 --- a/lisp/thingatpt.el +++ b/lisp/thingatpt.el @@ -441,7 +441,7 @@ the bounds of a possible ill-formed URI (one lacking a scheme)." ;; Otherwise, find the bounds within which a URI may exist. The ;; method is similar to `ffap-string-at-point'. Note that URIs ;; may contain parentheses but may not contain spaces (RFC3986). - (let* ((allowed-chars "--:=&?$+@-Z_[:alpha:]~#,%;*()!'") + (let* ((allowed-chars "--:=&?$+@-Z_[:alpha:]~#,%;*()!'[]") (skip-before "^[0-9a-zA-Z]") (skip-after ":;.,!?'") (pt (point)) diff --git a/lisp/thread.el b/lisp/thread.el index 1e6e9e75a72..c0cc5feb97c 100644 --- a/lisp/thread.el +++ b/lisp/thread.el @@ -58,20 +58,18 @@ An EVENT has the format :type 'number :version "27.1") -(defvar thread-list-mode-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map tabulated-list-mode-map) - (define-key map "b" #'thread-list-pop-to-backtrace) - (define-key map "s" nil) - (define-key map "sq" #'thread-list-send-quit-signal) - (define-key map "se" #'thread-list-send-error-signal) - (easy-menu-define nil map "" - '("Threads" - ["Show backtrace" thread-list-pop-to-backtrace t] - ["Send Quit Signal" thread-list-send-quit-signal t] - ["Send Error Signal" thread-list-send-error-signal t])) - map) - "Local keymap for `thread-list-mode' buffers.") +(defvar-keymap thread-list-mode-map + :doc "Local keymap for `thread-list-mode' buffers." + :parent tabulated-list-mode-map + "b" #'thread-list-pop-to-backtrace + "s" nil + "s q" #'thread-list-send-quit-signal + "s e" #'thread-list-send-error-signal + :menu + '("Threads" + ["Show backtrace" thread-list-pop-to-backtrace t] + ["Send Quit Signal" thread-list-send-quit-signal t] + ["Send Error Signal" thread-list-send-error-signal t])) (define-derived-mode thread-list-mode tabulated-list-mode "Thread-List" "Major mode for monitoring Lisp threads." diff --git a/lisp/url/ChangeLog.1 b/lisp/url/ChangeLog.1 index 2f7813e64cd..1b5ddc1e768 100644 --- a/lisp/url/ChangeLog.1 +++ b/lisp/url/ChangeLog.1 @@ -366,7 +366,7 @@ * url.el, url-queue.el, url-parse.el, url-http.el, url-future.el: * url-dav.el, url-cookie.el: Use cl-lib. * url-util.el, url-privacy.el, url-nfs.el, url-misc.el, url-methods.el: - * url-gw.el, url-file.el, url-expand.el: Dont use CL. + * url-gw.el, url-file.el, url-expand.el: Don't use CL. 2012-06-30 Glenn Morris <rgm@gnu.org> diff --git a/lisp/url/url-irc.el b/lisp/url/url-irc.el index 9161f7d13e9..f97b6de6fe7 100644 --- a/lisp/url/url-irc.el +++ b/lisp/url/url-irc.el @@ -38,11 +38,13 @@ The function should take the following arguments: PORT - the port number of the IRC server to contact CHANNEL - What channel on the server to visit right away (can be nil) USER - What username to use -PASSWORD - What password to use" +PASSWORD - What password to use. + SCHEME - a URI scheme, such as \"irc\" or \"ircs\"" :type '(choice (const :tag "rcirc" :value url-irc-rcirc) (const :tag "ERC" :value url-irc-erc) (const :tag "ZEN IRC" :value url-irc-zenirc) (function :tag "Other")) + :version "29.1" ; Added SCHEME :group 'url) ;; External. @@ -51,7 +53,7 @@ PASSWORD - What password to use" (defvar zenirc-server-alist) (defvar zenirc-buffer-name) -(defun url-irc-zenirc (host port channel user password) +(defun url-irc-zenirc (host port channel user password _) (let ((zenirc-buffer-name (if (and user host port) (format "%s@%s:%d" user host port) (format "%s:%d" host port))) @@ -65,14 +67,14 @@ PASSWORD - What password to use" (insert "/join " channel) (zenirc-send-line)))) -(defun url-irc-rcirc (host port channel user password) +(defun url-irc-rcirc (host port channel user password _) (let ((chan (when channel (concat "#" channel)))) (rcirc-connect host port user nil nil (when chan (list chan)) password) (when chan (switch-to-buffer (concat chan "@" host))))) -(defun url-irc-erc (host port channel user password) - (erc-handle-irc-url host port channel user password)) +(defun url-irc-erc (host port channel user password scheme) + (erc-handle-irc-url host port channel user password scheme)) ;;;###autoload (defun url-irc (url) @@ -80,16 +82,32 @@ PASSWORD - What password to use" (port (url-port url)) (pass (url-password url)) (user (url-user url)) - (chan (url-filename url))) + (chan (url-filename url)) + (type (url-type url)) + (compatp (eql 5 (cdr (func-arity url-irc-function))))) (if (url-target url) (setq chan (concat chan "#" (url-target url)))) (if (string-match "^/" chan) (setq chan (substring chan 1 nil))) (if (= (length chan) 0) (setq chan nil)) - (funcall url-irc-function host port chan user pass) + (when compatp + (lwarn 'url :error "Obsolete value for `url-irc-function'")) + (apply url-irc-function + host port chan user pass (unless compatp (list type))) nil)) +;;;; ircs:// + +;; The function `url-scheme-get-property' tries and fails to load the +;; nonexistent url-ircs.el but falls back to using the following: + +;;;###autoload +(defconst url-ircs-default-port 6697 "Default port for IRCS connections.") + +;;;###autoload +(defalias 'url-ircs 'url-irc) + (provide 'url-irc) ;;; url-irc.el ends here diff --git a/lisp/vc/add-log.el b/lisp/vc/add-log.el index e3c0e2ca06d..a1d6152ee21 100644 --- a/lisp/vc/add-log.el +++ b/lisp/vc/add-log.el @@ -1188,7 +1188,7 @@ file were isearch was started." ((and wrap (null file)) (current-buffer)) ;; When there is no next file, file-exists-p raises the error to be - ;; catched by the search function that displays the error message. + ;; caught by the search function that displays the error message. ((file-exists-p file) (find-file-noselect file)) (t diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index a9591c9d82e..357ce001b3c 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -306,7 +306,7 @@ well." ;; terminal supporting 24 bit colors) doesn't render well in terminal ;; supporting only 256 colors. Concretely, both #ffeeee ;; (diff-removed) and #eeffee (diff-added) are mapped to the same -;; greyish color. "min-colors 257" ensures that those colors are not +;; grayish color. "min-colors 257" ensures that those colors are not ;; used terminals supporting only 256 colors. However, any number ;; between 257 and 2^24 (16777216) would do. diff --git a/lisp/vc/ediff-diff.el b/lisp/vc/ediff-diff.el index 07b853817d1..24647de576d 100644 --- a/lisp/vc/ediff-diff.el +++ b/lisp/vc/ediff-diff.el @@ -942,6 +942,9 @@ one optional arguments, diff-number to refine.") (c-prev-pt nil) (anc-prev 1) diff-list shift-A shift-B shift-C + (A-idx "1") + (B-idx (if three-way-comp "2" "3")) + (C-idx (if three-way-comp "3" "2")) ) ;; diff list contains word numbers or points, depending on word-mode @@ -979,23 +982,23 @@ one optional arguments, diff-number to refine.") (let ((agreement (buffer-substring (match-beginning 1) (match-end 1)))) ;; if the files A and B are the same and not 3way-comparison, ;; ignore the difference - (if (or three-way-comp (not (string-equal agreement "3"))) - (let* ((a-begin (car (ediff-get-diff3-group "1"))) - (a-end (nth 1 (ediff-get-diff3-group "1"))) - (b-begin (car (ediff-get-diff3-group "2"))) - (b-end (nth 1 (ediff-get-diff3-group "2"))) - (c-or-anc-begin (car (ediff-get-diff3-group "3"))) - (c-or-anc-end (nth 1 (ediff-get-diff3-group "3"))) + (if (or three-way-comp (not (string-equal agreement C-idx))) + (let* ((a-begin (car (ediff-get-diff3-group A-idx))) + (a-end (nth 1 (ediff-get-diff3-group A-idx))) + (b-begin (car (ediff-get-diff3-group B-idx))) + (b-end (nth 1 (ediff-get-diff3-group B-idx))) + (c-or-anc-begin (car (ediff-get-diff3-group C-idx))) + (c-or-anc-end (nth 1 (ediff-get-diff3-group C-idx))) (state-of-merge - (cond ((string-equal agreement "1") 'prefer-A) - ((string-equal agreement "2") 'prefer-B) + (cond ((string-equal agreement A-idx) 'prefer-A) + ((string-equal agreement B-idx) 'prefer-B) (t ediff-default-variant))) (state-of-diff-merge (if (memq state-of-merge '(default-A prefer-A)) 'B 'A)) (state-of-diff-comparison - (cond ((string-equal agreement "1") 'A) - ((string-equal agreement "2") 'B) - ((string-equal agreement "3") 'C))) + (cond ((string-equal agreement A-idx) 'A) + ((string-equal agreement B-idx) 'B) + ((string-equal agreement C-idx) 'C))) state-of-ancestor c-begin c-end a-begin-pt a-end-pt @@ -1108,8 +1111,12 @@ one optional arguments, diff-number to refine.") (get-buffer-create (ediff-unique-buffer-name "*ediff-diff" "*")))) (message "Computing differences ...") - (ediff-exec-process ediff-diff3-program ediff-diff-buffer 'synchronize - ediff-actual-diff3-options file-A file-B file-C) + (apply #'ediff-exec-process ediff-diff3-program ediff-diff-buffer 'synchronize + ediff-actual-diff3-options + (cons file-A (if ediff-merge-with-ancestor-job + ;; Ancestor must be the middle file + (list file-C file-B) + (list file-B file-C)))) (ediff-prepare-error-list ediff-diff3-ok-lines-regexp ediff-diff-buffer) ;;(message "Computing differences ... done") diff --git a/lisp/vc/ediff-util.el b/lisp/vc/ediff-util.el index 0d96a195ade..f4068832215 100644 --- a/lisp/vc/ediff-util.el +++ b/lisp/vc/ediff-util.el @@ -1748,7 +1748,7 @@ With a prefix argument ARG, go back that many differences." regexp-skip ;; skip clashes, if necessary non-clash-skip - ;; skipp changed regions + ;; skip changed regions skip-changed ;; skip difference regions that differ in white space (and ediff-ignore-similar-regions diff --git a/lisp/vc/smerge-mode.el b/lisp/vc/smerge-mode.el index 003b26eca41..e13894d6b53 100644 --- a/lisp/vc/smerge-mode.el +++ b/lisp/vc/smerge-mode.el @@ -23,11 +23,10 @@ ;;; Commentary: ;; Provides a lightweight alternative to emerge/ediff. -;; To use it, simply add to your .emacs the following lines: ;; -;; (autoload 'smerge-mode "smerge-mode" nil t) +;; To use it, simply type `M-x smerge-mode'. ;; -;; you can even have it turned on automatically with the following +;; You can even have it turned on automatically with the following ;; piece of code in your .emacs: ;; ;; (defun sm-try-smerge () diff --git a/lisp/vc/vc-dav.el b/lisp/vc/vc-dav.el index 94621599e4a..1cd91c9f543 100644 --- a/lisp/vc/vc-dav.el +++ b/lisp/vc/vc-dav.el @@ -93,7 +93,7 @@ If EDITABLE is non-nil URL should be writable by the user and if locking is used for URL, a lock should also be set. If REV is non-nil, that is the revision to check out. If REV is the -empty string, that means to check ou tht ehead of the trunk. +empty string, that means to check out the head of the trunk. If optional arg DESTFILE is given, it is an alternate filename to write the contents to." diff --git a/lisp/vc/vc-git.el b/lisp/vc/vc-git.el index 74536309e29..a1ff03144bc 100644 --- a/lisp/vc/vc-git.el +++ b/lisp/vc/vc-git.el @@ -1883,7 +1883,8 @@ This command shares argument histories with \\[rgrep] and \\[grep]." "Show the contents of stash NAME." (interactive (list (vc-git-stash-read "Show stash: "))) (vc-setup-buffer "*vc-git-stash*") - (vc-git-command "*vc-git-stash*" 'async nil "stash" "show" "-p" name) + (vc-git-command "*vc-git-stash*" 'async nil + "stash" "show" "--color=never" "-p" name) (set-buffer "*vc-git-stash*") (setq buffer-read-only t) (diff-mode) diff --git a/lisp/vc/vc-rcs.el b/lisp/vc/vc-rcs.el index a4345c7d7e2..c41835e19f2 100644 --- a/lisp/vc/vc-rcs.el +++ b/lisp/vc/vc-rcs.el @@ -1192,7 +1192,7 @@ variable `vc-rcs-release' is set to the returned value." (defun vc-rcs-parse (&optional buffer) "Parse current buffer, presumed to be in RCS-style masterfile format. Optional arg BUFFER specifies another buffer to parse. Return an alist -of two elements, w/ keys `headers' and `revisions' and values in turn +of two elements, with keys `headers' and `revisions' and values in turn sub-alists. For `headers', the values unless otherwise specified are strings and the keys are: diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el index 513fbb23fee..fa3d58f770e 100644 --- a/lisp/vc/vc.el +++ b/lisp/vc/vc.el @@ -3347,6 +3347,8 @@ immediately after this one." (lambda (&rest args) (apply #'vc-user-edit-command (apply old args)))))) +;; This is used in .dir-locals.el in the Emacs source tree. +;;;###autoload (put 'vc-prepare-patches-separately 'safe-local-variable 'booleanp) (defcustom vc-prepare-patches-separately t "Whether `vc-prepare-patch' should generate a separate message for each patch. If nil, `vc-prepare-patch' creates a single email message by attaching @@ -3384,25 +3386,43 @@ If nil, no default will be used. This option may be set locally." (vc-root-dir)))) :buffer (current-buffer))))) +(defun vc-prepare-patch-prompt-revisions () + "Prompt the user for a list revisions. +Prepare a default value, depending on the current context. With +a numerical prefix argument, use the last N revisions as the +default value. If the current buffer is a log-view buffer, use +the marked commits. Otherwise fall back to the working revision +of the current file." + (vc-read-multiple-revisions + "Revisions: " nil nil nil + (or (and-let* ((arg current-prefix-arg) + (fs (vc-deduce-fileset t))) + (cl-loop with file = (caadr fs) + repeat (prefix-numeric-value arg) + for rev = (vc-working-revision file) + then (vc-call-backend + (car fs) 'previous-revision + file rev) + when rev collect it into revs + finally return (mapconcat #'identity revs ","))) + (and-let* ((revs (log-view-get-marked))) + (mapconcat #'identity revs ",")) + (and-let* ((file (buffer-file-name))) + (vc-working-revision file))))) + ;;;###autoload (defun vc-prepare-patch (addressee subject revisions) "Compose an Email sending patches for REVISIONS to ADDRESSEE. -If `vc-prepare-patches-separately' is nil, SUBJECT will be used -as the default subject for the message (and it will be prompted -for when called interactively). Otherwise a separate message -will be composed for each revision, with SUBJECT derived from the -invidividual commits. - -When invoked interactively in a Log View buffer with marked -revisions, those revisions will be used." +If `vc-prepare-patches-separately' is nil, use SUBJECT as the +default subject for the message, or prompt a subject when invoked +interactively. Otherwise compose a separate message for each +revision, with SUBJECT derived from each revision subject. +When invoked with a numerical prefix argument, use the last N +revisions. +When invoked interactively in a Log View buffer with +marked revisions, use those these." (interactive - (let ((revs (vc-read-multiple-revisions - "Revisions: " nil nil nil - (or (and-let* ((revs (log-view-get-marked))) - (mapconcat #'identity revs ",")) - (and-let* ((file (buffer-file-name))) - (vc-working-revision file))))) - to) + (let ((revs (vc-prepare-patch-prompt-revisions)) to) (require 'message) (while (null (setq to (completing-read-multiple (format-prompt @@ -3567,7 +3587,7 @@ to provide the `find-revision' operation instead." (defun vc-clone (remote &optional backend directory rev) "Use BACKEND to clone REMOTE into DIRECTORY. -If successful, returns the a string with the directory of the +If successful, returns the string with the directory of the checkout. If BACKEND is nil, iterate through every known backend in `vc-handled-backends' until one succeeds. If REV is non-nil, it indicates a specific revision to check out." @@ -3597,9 +3617,7 @@ It returns the last revision that changed LINE number in FILE." file (current-buffer)) (goto-char (point-min)) (forward-line (1- line)) - (let ((rev (vc-call-backend - (vc-backend file) - 'annotate-extract-revision-at-line))) + (let ((rev (vc-call annotate-extract-revision-at-line file))) (if (consp rev) (car rev) rev)))) diff --git a/lisp/whitespace.el b/lisp/whitespace.el index 791a0a0b4ee..25ea07e9db7 100644 --- a/lisp/whitespace.el +++ b/lisp/whitespace.el @@ -746,7 +746,7 @@ The value should be a cons whose car specifies the regexp to match visualization of SPACEs, and the cdr specifies the regexp to match visualization of TABs. -The indentation characters are highlighted using the `whitespace-indentationp' +The indentation characters are highlighted using the `whitespace-indentation' face. This variable is used when `whitespace-style' includes `indentation', `indentation::tab' or `indentation::space'." diff --git a/lisp/window.el b/lisp/window.el index 905803b19e6..dd23ab1d394 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -1,7 +1,6 @@ ;;; window.el --- GNU Emacs window commands aside from those written in C -*- lexical-binding:t -*- -;; Copyright (C) 1985, 1989, 1992-1994, 2000-2022 Free Software -;; Foundation, Inc. +;; Copyright (C) 1985-2022 Free Software Foundation, Inc. ;; Maintainer: emacs-devel@gnu.org ;; Keywords: internal @@ -9173,7 +9172,7 @@ present. See also `fit-frame-to-buffer-sizes'." This list specifies the total maximum and minimum numbers of lines and the maximum and minimum numbers of columns of the body of the root window of any frame that shall be fit to its buffer. -Any value specified by ths variable will be overridden by the +Any value specified by this variable will be overridden by the corresponding argument of `fit-frame-to-buffer', if non-nil. On window systems where the menubar can wrap, fitting a frame to @@ -10562,27 +10561,25 @@ displaying that processes's buffer." (define-key ctl-x-4-map "1" 'same-window-prefix) (define-key ctl-x-4-map "4" 'other-window-prefix) -(defvar other-window-repeat-map - (let ((map (make-sparse-keymap))) - (define-key map "o" 'other-window) - (define-key map "O" (lambda () - (interactive) - (setq repeat-map 'other-window-repeat-map) - (other-window -1))) - map) - "Keymap to repeat `other-window' key sequences. Used in `repeat-mode'.") +(defvar-keymap other-window-repeat-map + :doc "Keymap to repeat `other-window' key sequences. +Used in `repeat-mode'." + "o" #'other-window + "O" (lambda () + (interactive) + (setq repeat-map 'other-window-repeat-map) + (other-window -1))) (put 'other-window 'repeat-map 'other-window-repeat-map) -(defvar resize-window-repeat-map - (let ((map (make-sparse-keymap))) - ;; Standard keys: - (define-key map "^" 'enlarge-window) - (define-key map "}" 'enlarge-window-horizontally) - (define-key map "{" 'shrink-window-horizontally) - ;; Additional keys: - (define-key map "v" 'shrink-window) - map) - "Keymap to repeat window resizing commands. Used in `repeat-mode'.") +(defvar-keymap resize-window-repeat-map + :doc "Keymap to repeat window resizing commands. +Used in `repeat-mode'." + ;; Standard keys: + "^" #'enlarge-window + "}" #'enlarge-window-horizontally + "{" #'shrink-window-horizontally + ;; Additional keys: + "v" #'shrink-window) (put 'enlarge-window 'repeat-map 'resize-window-repeat-map) (put 'enlarge-window-horizontally 'repeat-map 'resize-window-repeat-map) (put 'shrink-window-horizontally 'repeat-map 'resize-window-repeat-map) diff --git a/lisp/woman.el b/lisp/woman.el index 7f494a3b686..2b456fed3cb 100644 --- a/lisp/woman.el +++ b/lisp/woman.el @@ -1751,21 +1751,17 @@ Leave point at end of new text. Return length of inserted text." ;;; Major mode (Man) interface: -(defvar woman-mode-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map Man-mode-map) - - (define-key map "R" #'woman-reformat-last-file) - (define-key map "w" #'woman) - (define-key map "\en" #'WoMan-next-manpage) - (define-key map "\ep" #'WoMan-previous-manpage) - (define-key map [M-mouse-2] #'woman-follow-word) - - ;; We don't need to call `man' when we are in `woman-mode'. - (define-key map [remap man] #'woman) - (define-key map [remap man-follow] #'woman-follow) - map) - "Keymap for `woman-mode'.") +(defvar-keymap woman-mode-map + :doc "Keymap for `woman-mode'." + :parent Man-mode-map + "R" #'woman-reformat-last-file + "w" #'woman + "M-n" #'WoMan-next-manpage + "M-p" #'WoMan-previous-manpage + "M-<mouse-2>" #'woman-follow-word + ;; We don't need to call `man' when we are in `woman-mode'. + "<remap> <man>" #'woman + "<remap> <man-follow>" #'woman-follow) (defun woman-follow (topic) "Get a Un*x manual page of the item under point and put it in a buffer." diff --git a/lisp/x-dnd.el b/lisp/x-dnd.el index 058ab99f5cb..b3465e757a9 100644 --- a/lisp/x-dnd.el +++ b/lisp/x-dnd.el @@ -818,7 +818,7 @@ has been pressed." (let ((inhibit-message t)) (funcall function amt)) ;; Do not error at buffer limits. Show a message instead. - ;; This is especially important here because signalling an + ;; This is especially important here because signaling an ;; error will mess up the drag-and-drop operation. (beginning-of-buffer (message (error-message-string '(beginning-of-buffer)))) @@ -1468,7 +1468,7 @@ instead of returning \"E\".") (dnd-get-local-file-name local-file-uri)))) (if (not local-name) '(STRING . "F") - ;; We want errors to be signalled immediately during ERT + ;; We want errors to be signaled immediately during ERT ;; testing, instead of being silently handled. (bug#56712) (if x-dnd-xds-testing (prog1 '(STRING . "S") diff --git a/lisp/xwidget.el b/lisp/xwidget.el index 109748baec6..7195ba9d894 100644 --- a/lisp/xwidget.el +++ b/lisp/xwidget.el @@ -20,15 +20,17 @@ ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. ;;; Commentary: -;; -;; See xwidget.c for more api functions. + +;; See the node "(emacs)Embedded WebKit Widgets" in the Emacs manual for +;; help on user-facing features, and "(elisp)Embedded Native Widgets" in +;; the Emacs Lisp reference manual for help on more API functions. + +;;; Code: ;; This breaks compilation when we don't have xwidgets. ;; And is pointless when we do, since it's in C and so preloaded. ;;(require 'xwidget-internal) -;;; Code: - (require 'cl-lib) (require 'bookmark) (require 'format-spec) diff --git a/msdos/autogen/config.in b/msdos/autogen/config.in index 14782ab4bfe..4b1cfb96e86 100644 --- a/msdos/autogen/config.in +++ b/msdos/autogen/config.in @@ -217,7 +217,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ whether the gnulib module scanf shall be considered present. */ #undef GNULIB_SCANF -/* Define if ths system is compatible with GNU/Linux. */ +/* Define if this system is compatible with GNU/Linux. */ #undef GNU_LINUX /* Define to 1 if you want to use the GNU memory allocator. */ diff --git a/nt/inc/ms-w32.h b/nt/inc/ms-w32.h index 2dd9a9a476c..98e31df70c8 100644 --- a/nt/inc/ms-w32.h +++ b/nt/inc/ms-w32.h @@ -27,7 +27,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ #include <mingw_time.h> /* MinGW-w64 gcc does not automotically define a macro for - differentiating it fom MinGW gcc. We need to test the presence of + differentiating it from MinGW gcc. We need to test the presence of __MINGW64_VERSION_MAJOR in _mingw.h: */ #ifdef __MINGW32__ # include <_mingw.h> diff --git a/src/ChangeLog.10 b/src/ChangeLog.10 index ba1cea18d4b..1b18ae5ec5d 100644 --- a/src/ChangeLog.10 +++ b/src/ChangeLog.10 @@ -7899,7 +7899,7 @@ * buffer.c (scroll-up-aggressively, scroll-down-aggressively): * keymap.c (Fminor_mode_key_binding): * macterm.c (mac-emulate-three-button-mouse): - Delete duplicate duplicate words. + Delete duplicate words. 2005-07-18 Ken Raeburn <raeburn@gnu.org> diff --git a/src/ChangeLog.11 b/src/ChangeLog.11 index 15ab2271718..a00ca453ca4 100644 --- a/src/ChangeLog.11 +++ b/src/ChangeLog.11 @@ -7503,7 +7503,7 @@ 2010-05-28 Kenichi Handa <handa@m17n.org> * font.c (font_delete_unmatched): Check Vface_ignored_fonts. - Don't sheck SPEC if it is nil. + Don't check SPEC if it is nil. (font_list_entities): Call font_delete_unmatched if Vface_ignored_fonts is non-nil. (Bug#6287) @@ -8639,7 +8639,7 @@ * keyboard.c: QClabel is new. (parse_tool_bar_item): Take out QClabel from tool bar items. - Try to construct a label if ther is no QClabel. + Try to construct a label if there is no QClabel. (syms_of_keyboard): Intern :label as QClabel. * dispextern.h (tool_bar_item_idx): TOOL_BAR_ITEM_LABEL is new. @@ -11988,7 +11988,7 @@ * cmds.c (nonundocount): New global variable. (keys_of_cmds): Initialize it. - (Fself_insert_command): Use it to combine upto 20 sequential chars + (Fself_insert_command): Use it to combine up to 20 sequential chars into a single undo entry, just like the Qself_insert_command code in keyboard.c does. Call frame_make_pointer_invisible, also like the Qself_insert_command diff --git a/src/ChangeLog.12 b/src/ChangeLog.12 index 18618bbfb25..7f77c0ca077 100644 --- a/src/ChangeLog.12 +++ b/src/ChangeLog.12 @@ -73,7 +73,7 @@ * lisp.h (adjust_after_replace): Extern it. - * coding.c (detect_coding): Cound the heading ASCII bytes in the + * coding.c (detect_coding): Count the heading ASCII bytes in the case of detection for coding_category_utf_8_auto. (decode_coding_gap) [not CODING_DISABLE_ASCII_OPTIMIZATION]: Skip decoding if all bytes are ASCII. @@ -1809,7 +1809,7 @@ * nsfns.m (Fns_do_applescript): Run event loop until script has been executed (Bug#12969). - (ns_run_ascript): Chech as_script for nil, set to nil after + (ns_run_ascript): Check as_script for nil, set to nil after executing script. 2012-12-22 Martin Rudalics <rudalics@gmx.at> @@ -14132,7 +14132,7 @@ (coding_set_destination): Return how many bytes coding->destination was relocated. (CODING_DECODE_CHAR, CODING_ENCODE_CHAR, CODING_CHAR_CHARSET) - (CODING_CHAR_CHARSET_P): Adjust for the avove changes. + (CODING_CHAR_CHARSET_P): Adjust for the above changes. 2011-12-05 Kazuhiro Ito <kzhr@d1.dion.ne.jp> (tiny change) @@ -19967,7 +19967,7 @@ 2011-05-05 Eli Zaretskii <eliz@gnu.org> * w32heap.c (allocate_heap) [USE_LISP_UNION_TYPE || USE_LSB_TAG]: - New version that can reserve upto 2GB of heap space. + New version that can reserve up to 2GB of heap space. 2011-05-05 Chong Yidong <cyd@stupidchicken.com> diff --git a/src/ChangeLog.13 b/src/ChangeLog.13 index 268a59219c4..91f8005ac51 100644 --- a/src/ChangeLog.13 +++ b/src/ChangeLog.13 @@ -1459,11 +1459,11 @@ (frame_default_tool_bar_height): Extern. * gtkutil.c (xg_frame_set_char_size): Pass Qxg_frame_set_char_size to adjust_frame_size. - * nsfns.m (Fx_create_frame): Pass Pass Qx_create_frame_1 and + * nsfns.m (Fx_create_frame): Pass Qx_create_frame_1 and Qx_create_frame_2 to adjust_frame_size. * w32fns.c (x_change_tool_bar_height): Call adjust_frame_size with inhibit 1 when we have not redisplayed the tool bar yet. - (Fx_create_frame): Pass Pass Qx_create_frame_1 and + (Fx_create_frame): Pass Qx_create_frame_1 and Qx_create_frame_2 to adjust_frame_size. * w32menu.c (set_frame_menubar): Simplify adjust_frame_size call. @@ -1476,7 +1476,7 @@ frame size accordingly. * xfns.c (x_change_tool_bar_height): Call adjust_frame_size with inhibit 1 when we have not redisplayed the tool bar yet. - (Fx_create_frame): Pass Pass Qx_create_frame_1 and + (Fx_create_frame): Pass Qx_create_frame_1 and Qx_create_frame_2 to adjust_frame_size. 2015-01-12 Paul Eggert <eggert@cs.ucla.edu> @@ -7498,7 +7498,7 @@ 2014-04-16 Eli Zaretskii <eliz@gnu.org> * insdel.c (invalidate_buffer_caches): When deleting or replacing - text, invalidate the bidi_paragraph_cache upto and including the + text, invalidate the bidi_paragraph_cache up to and including the preceding newline. 2014-04-16 Paul Eggert <eggert@cs.ucla.edu> @@ -10183,7 +10183,7 @@ (w32_wnd_proc): Handle bottom divider width. For WM_WINDOWPOSCHANGING return zero if we resize pixelwise. (Fx_create_frame): Default divider width parameters. - Caclulate sizes pixelwise. Add vertical drag cursor support. + Calculate sizes pixelwise. Add vertical drag cursor support. (x_create_tip_frame): Default divider widths to zero. Pixelize call to change_frame_size. (Fx_show_tip): Add handling of divider widths. Pixelize window @@ -10868,7 +10868,7 @@ * xdisp.c (syms_of_xdisp): New vars redisplay--all-windows-cause and redisplay--mode-lines-cause. - (redisplay_internal): Keep them uptodate. Remove redundant check of + (redisplay_internal): Keep them up-to-date. Remove redundant check of buffer_shared_and_changed. * *.[chm]: Number every assignment to update_mode_lines so we can track why it is set. @@ -12566,7 +12566,7 @@ 2013-09-16 Dmitry Antipov <dmantipov@yandex.ru> Do not copy X event in handle_one_xevent except KeyPress case. - Wnen XEvent is processed, it is unlikely to be changed except + When XEvent is processed, it is unlikely to be changed except KeyPress case, so we can avoid copying and use const pointer to const data to make sure that an event is not changed elsewhere. * xterm.c (handle_one_xevent): Change 2nd arg to 'const XEvent * diff --git a/src/ChangeLog.5 b/src/ChangeLog.5 index c74e44d7a2f..408a934ce2e 100644 --- a/src/ChangeLog.5 +++ b/src/ChangeLog.5 @@ -2316,7 +2316,7 @@ 1995-02-15 Paul Reilly <pmr@geech.gnu.ai.mit.edu> - * s/dgux.h (LIB_MOTIF): Add -lgen to provide provide the symbols + * s/dgux.h (LIB_MOTIF): Add -lgen to provide the symbols `regcmp' and `regex'. 1995-02-15 Richard Stallman <rms@pogo.gnu.ai.mit.edu> diff --git a/src/ChangeLog.6 b/src/ChangeLog.6 index fc7cc5e4d48..f5653efd91e 100644 --- a/src/ChangeLog.6 +++ b/src/ChangeLog.6 @@ -2225,7 +2225,7 @@ 1996-02-08 Eli Zaretskii <eliz@is.elta.co.il> - * fileio.c (Fmake_temp_name) [MS-DOS]: Allow upto 8 characters in + * fileio.c (Fmake_temp_name) [MS-DOS]: Allow up to 8 characters in the prefix of the temporary file name. 1996-02-07 Richard Stallman <rms@mole.gnu.ai.mit.edu> diff --git a/src/ChangeLog.7 b/src/ChangeLog.7 index e893a2a6d82..9c6fd810d34 100644 --- a/src/ChangeLog.7 +++ b/src/ChangeLog.7 @@ -1215,19 +1215,19 @@ * ccl.c: Change term translation to code conversion, then change terms unify/unification to translate/translation respectively - throughtout the file. + throughout the file. * charset.c: Change terms unify/unification to - translate/translation respectively throughtout the file. + translate/translation respectively throughout the file. (ONE_BYTE_CHAR_WIDTH): Delete unnecessary continuation line at the tail. * charset.h: Change terms unify/unification to - translate/translation respectively throughtout the file. + translate/translation respectively throughout the file. (GET_TRANSLATION_TABLE): Name changed from UNIFICATION_ID_TABLE. * coding.c: Change terms unify/unification to - translate/translation respectively throughtout the file. + translate/translation respectively throughout the file. (encode_coding_iso2022): Fix bug in encoding a text ending by a composite character. (check_composing_code): If we are decoding the last block of data, diff --git a/src/ChangeLog.8 b/src/ChangeLog.8 index ef2472a0f33..c0e3523c648 100644 --- a/src/ChangeLog.8 +++ b/src/ChangeLog.8 @@ -1272,7 +1272,7 @@ * xdisp.c (display_line): Set charpos of first glyph in blank lines not corresponding to any text to -1, even if no glyphs are - filled in in that line. + filled in on that line. 1999-11-01 Gerd Moellmann <gerd@gnu.org> @@ -3155,7 +3155,7 @@ * xdisp.c (resize_mini_window): Don't resize if Vmax_mini_window_height is nil. Otherwise, use a default if - Vmax_mini_window_height is not ot a number. + Vmax_mini_window_height is not a number. (syms_of_xdisp): Extend documentation of Vmax_mini_window_height. 1999-08-25 Alexandre Oliva <oliva@dcc.unicamp.br> @@ -5704,7 +5704,7 @@ (x_scroll_bar_expose): Make no-op for toolkit scroll bars. (x_scroll_bar_create): Create and show a scroll bar widget if using toolkit scroll bars. - (x_scroll_bar_move): Handle tookit scroll bars. + (x_scroll_bar_move): Handle toolkit scroll bars. * Makefile.in (LIBW): Use Xaw3d if present. diff --git a/src/alloc.c b/src/alloc.c index 6862cf916fb..d3f696d5ade 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -6279,11 +6279,6 @@ garbage_collect (void) image_prune_animation_caches (false); #endif - /* ELisp code run by `gc-post-hook' could result in itree iteration, - which must not happen while the itree is already busy. See - bug#58639. */ - eassert (!itree_iterator_busy_p ()); - if (!NILP (Vpost_gc_hook)) { specpdl_ref gc_count = inhibit_garbage_collection (); @@ -7780,13 +7775,23 @@ allocated since the last garbage collection. All data types count. Garbage collection happens automatically only when `eval' is called. By binding this temporarily to a large number, you can effectively -prevent garbage collection during a part of the program. +prevent garbage collection during a part of the program. But be +sure to get back to the normal value soon enough, to avoid system-wide +memory pressure, and never use a too-high value for prolonged periods +of time. See also `gc-cons-percentage'. */); DEFVAR_LISP ("gc-cons-percentage", Vgc_cons_percentage, doc: /* Portion of the heap used for allocation. Garbage collection can happen automatically once this portion of the heap has been allocated since the last garbage collection. + +By binding this temporarily to a large number, you can effectively +prevent garbage collection during a part of the program. But be +sure to get back to the normal value soon enough, to avoid system-wide +memory pressure, and never use a too-high value for prolonged periods +of time. + If this portion is smaller than `gc-cons-threshold', this is ignored. */); Vgc_cons_percentage = make_float (0.1); diff --git a/src/buffer.c b/src/buffer.c index ec2d34daf89..d948aaa2662 100644 --- a/src/buffer.c +++ b/src/buffer.c @@ -937,19 +937,16 @@ delete_all_overlays (struct buffer *b) if (! b->overlays) return; - /* FIXME: This loop sets the overlays' `buffer` field to NULL but - doesn't set the itree_nodes' `parent`, `left` and `right` - fields accordingly. I believe it's harmless, but a bit untidy since - other parts of the code are careful to set those fields to NULL when - the overlay is deleted. - Of course, we can't set them to NULL from within the iteration - because the iterator may need them (tho we could if we added - an ITREE_POST_ORDER iteration order). */ - ITREE_FOREACH (node, b->overlays, PTRDIFF_MIN, PTRDIFF_MAX, ASCENDING) + /* The general rule is that the tree cannot be modified from within + ITREE_FOREACH, but here we bend this rule a little because we know + that the POST_ORDER iterator will not need to look at `node` again. */ + ITREE_FOREACH (node, b->overlays, PTRDIFF_MIN, PTRDIFF_MAX, POST_ORDER) { modify_overlay (b, node->begin, node->end); - /* Where are the nodes freed ? --ap */ XOVERLAY (node->data)->buffer = NULL; + node->parent = NULL; + node->left = NULL; + node->right = NULL; } itree_clear (b->overlays); } @@ -2985,17 +2982,13 @@ overlays_in (ptrdiff_t beg, ptrdiff_t end, bool extend, if (node->begin > end) { next = min (next, node->begin); - ITREE_FOREACH_ABORT (); break; } else if (node->begin == end) { next = node->begin; if ((! empty || end < ZV) && beg < end) - { - ITREE_FOREACH_ABORT (); - break; - } + break; if (empty && node->begin != node->end) continue; } @@ -3050,7 +3043,6 @@ next_overlay_change (ptrdiff_t pos) of pos, because the search is limited to [pos,next) . */ eassert (node->begin < next); next = node->begin; - ITREE_FOREACH_ABORT (); break; } else if (node->begin < node->end && node->end < next) @@ -3155,10 +3147,7 @@ overlay_touches_p (ptrdiff_t pos) pos. */ ITREE_FOREACH (node, current_buffer->overlays, pos - 1, pos + 1, DESCENDING) if (node->begin == pos || node->end == pos) - { - ITREE_FOREACH_ABORT (); - return true; - } + return true; return false; } @@ -3835,7 +3824,9 @@ and also contained within the specified region. Empty overlays are included in the result if they are located at BEG, between BEG and END, or at END provided END denotes the position at the -end of the accessible part of the buffer. */) +end of the accessible part of the buffer. + +The resulting list of overlays is in an arbitrary unpredictable order. */) (Lisp_Object beg, Lisp_Object end) { ptrdiff_t len, noverlays; diff --git a/src/comp.c b/src/comp.c index 14012634ccc..b6072a866e6 100644 --- a/src/comp.c +++ b/src/comp.c @@ -947,7 +947,7 @@ obj_to_reloc (Lisp_Object obj) } xsignal1 (Qnative_ice, - build_string ("cant't find data in relocation containers")); + build_string ("can't find data in relocation containers")); assume (false); found: @@ -5609,7 +5609,7 @@ file_in_eln_sys_dir (Lisp_Object filename) /* Load related routines. */ DEFUN ("native-elisp-load", Fnative_elisp_load, Snative_elisp_load, 1, 2, 0, doc: /* Load native elisp code FILENAME. -LATE_LOAD has to be non-nil when loading for deferred compilation. */) +LATE-LOAD has to be non-nil when loading for deferred compilation. */) (Lisp_Object filename, Lisp_Object late_load) { CHECK_STRING (filename); diff --git a/src/dbusbind.c b/src/dbusbind.c index 1c74180f15c..440142757ec 100644 --- a/src/dbusbind.c +++ b/src/dbusbind.c @@ -422,7 +422,7 @@ xd_signature (char *signature, int dtype, int parent_type, Lisp_Object object) case DBUS_TYPE_STRING: case DBUS_TYPE_OBJECT_PATH: case DBUS_TYPE_SIGNATURE: - /* We dont check the syntax of signature. This will be done by + /* We don't check the syntax of signature. This will be done by libdbus. */ if (dtype == DBUS_TYPE_OBJECT_PATH) XD_DBUS_VALIDATE_PATH (object) @@ -748,7 +748,7 @@ xd_append_arg (int dtype, Lisp_Object object, DBusMessageIter *iter) case DBUS_TYPE_STRING: case DBUS_TYPE_OBJECT_PATH: case DBUS_TYPE_SIGNATURE: - /* We dont check the syntax of signature. This will be done + /* We don't check the syntax of signature. This will be done by libdbus. */ if (dtype == DBUS_TYPE_OBJECT_PATH) XD_DBUS_VALIDATE_PATH (object) diff --git a/src/dispextern.h b/src/dispextern.h index 2f5f4335fe5..2afbdeabaab 100644 --- a/src/dispextern.h +++ b/src/dispextern.h @@ -3495,7 +3495,8 @@ extern bool cursor_in_mouse_face_p (struct window *w); extern void tty_draw_row_with_mouse_face (struct window *, struct glyph_row *, int, int, enum draw_glyphs_face); extern void display_tty_menu_item (const char *, int, int, int, int, bool); - +extern struct glyph *x_y_to_hpos_vpos (struct window *, int, int, int *, int *, + int *, int *, int *); /* Flags passed to try_window. */ #define TRY_WINDOW_CHECK_MARGINS (1 << 0) #define TRY_WINDOW_IGNORE_FONTS_CHANGE (1 << 1) diff --git a/src/emacs-module.c b/src/emacs-module.c index fcdf103c19b..35d6e9e0d7a 100644 --- a/src/emacs-module.c +++ b/src/emacs-module.c @@ -561,7 +561,7 @@ static struct Lisp_Module_Function * allocate_module_function (void) { return ALLOCATE_PSEUDOVECTOR (struct Lisp_Module_Function, - interactive_form, PVEC_MODULE_FUNCTION); + command_modes, PVEC_MODULE_FUNCTION); } #define XSET_MODULE_FUNCTION(var, ptr) \ diff --git a/src/emacs.c b/src/emacs.c index 1b2aa9442b7..85102acd28e 100644 --- a/src/emacs.c +++ b/src/emacs.c @@ -432,9 +432,9 @@ terminate_due_to_signal (int sig, int backtrace_limit) if (sig == SIGTERM || sig == SIGHUP || sig == SIGINT) { /* Avoid abort in shut_down_emacs if we were interrupted - by SIGINT in noninteractive usage, as in that case we - don't care about the message stack. */ - if (sig == SIGINT && noninteractive) + in noninteractive usage, as in that case we don't + care about the message stack. */ + if (noninteractive) clear_message_stack (); Fkill_emacs (make_fixnum (sig), Qnil); } @@ -1932,7 +1932,6 @@ Using an Emacs configured with --with-x-toolkit=lucid does not have this problem running_asynch_code = 0; init_random (); init_xfaces (); - init_itree (); #if defined HAVE_JSON && !defined WINDOWSNT init_json (); @@ -3105,8 +3104,6 @@ You must run Emacs in batch mode in order to dump it. */) gflags.will_dump_with_unexec_ = false; gflags.dumped_with_unexec_ = true; - forget_itree (); - alloc_unexec_pre (); unexec (SSDATA (filename), !NILP (symfile) ? SSDATA (symfile) : 0); diff --git a/src/eval.c b/src/eval.c index ea238299488..7327d681f9a 100644 --- a/src/eval.c +++ b/src/eval.c @@ -1329,7 +1329,7 @@ Then the value of the last BODY form is returned from the `condition-case' expression. The special handler (:success BODY...) is invoked if BODYFORM terminated -without signalling an error. BODY is then evaluated with VAR bound to +without signaling an error. BODY is then evaluated with VAR bound to the value returned by BODYFORM. See also the function `signal' for more info. @@ -1716,7 +1716,6 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) Lisp_Object clause = Qnil; struct handler *h; - eassert (!itree_iterator_busy_p ()); if (gc_in_progress || waiting_for_input) emacs_abort (); @@ -1810,7 +1809,7 @@ signal_or_quit (Lisp_Object error_symbol, Lisp_Object data, bool keyboard_quit) unbind_to (count, Qnil); } - /* If an error is signalled during a Lisp hook in redisplay, write a + /* If an error is signaled during a Lisp hook in redisplay, write a backtrace into the buffer *Redisplay-trace*. */ if (!debugger_called && !NILP (error_symbol) && backtrace_on_redisplay_error diff --git a/src/font.h b/src/font.h index 3475189206f..d36c45a53c4 100644 --- a/src/font.h +++ b/src/font.h @@ -220,13 +220,13 @@ enum font_property_index #define FONT_WIDTH_FOR_FACE(font) \ font_style_symbolic (font, FONT_WIDTH_INDEX, true) -/* Return the numeric weight value corresponding ot the symbol NAME. */ +/* Return the numeric weight value corresponding to the symbol NAME. */ #define FONT_WEIGHT_NAME_NUMERIC(name) \ (font_style_to_value (FONT_WEIGHT_INDEX, (name), false) >> 8) -/* Return the numeric slant value corresponding ot the symbol NAME. */ +/* Return the numeric slant value corresponding to the symbol NAME. */ #define FONT_SLANT_NAME_NUMERIC(name) \ (font_style_to_value (FONT_SLANT_INDEX, (name), false) >> 8) -/* Return the numeric width value corresponding ot the symbol NAME. */ +/* Return the numeric width value corresponding to the symbol NAME. */ #define FONT_WIDTH_NAME_NUMERIC(name) \ (font_style_to_value (FONT_WIDTH_INDEX, (name), false) >> 8) diff --git a/src/fontset.c b/src/fontset.c index 4b91eff2ef6..b82737d005a 100644 --- a/src/fontset.c +++ b/src/fontset.c @@ -1663,7 +1663,17 @@ overwrites the previous settings. */) { update_auto_fontset_alist (font_object, fontset_obj); AUTO_FRAME_ARG (arg, Qfont, Fcons (fontset, font_object)); - Fmodify_frame_parameters (fr, arg); + +#ifdef HAVE_WINDOW_SYSTEM + if (FRAME_WINDOW_P (f)) + /* This is a window-system frame. Prevent changes of + the `font' parameter here from messing with the + `font-parameter' frame property, as the frame + parameter is not being changed by the user. */ + gui_set_frame_parameters_1 (f, arg, true); + else +#endif + Fmodify_frame_parameters (fr, arg); } } } diff --git a/src/frame.c b/src/frame.c index f076a5ba54e..b57b296be54 100644 --- a/src/frame.c +++ b/src/frame.c @@ -4119,10 +4119,17 @@ frame_float (struct frame *f, Lisp_Object val, enum frame_float_type what, If a parameter is not specially recognized, do nothing special; otherwise call the `gui_set_...' function for that parameter. Except for certain geometry properties, always call store_frame_param - to store the new value in the parameter alist. */ + to store the new value in the parameter alist. + + DEFAULT_PARAMETER should be set if the alist was not specified by + the user, or by the face code to set the `font' parameter. In that + case, the `font-parameter' frame parameter should not be changed, + so dynamic-setting.el can restore the user's selected font + correctly. */ void -gui_set_frame_parameters (struct frame *f, Lisp_Object alist) +gui_set_frame_parameters_1 (struct frame *f, Lisp_Object alist, + bool default_parameter) { Lisp_Object tail, frame; @@ -4249,7 +4256,7 @@ gui_set_frame_parameters (struct frame *f, Lisp_Object alist) } else { - register Lisp_Object param_index, old_value; + Lisp_Object param_index, old_value; old_value = get_frame_param (f, prop); @@ -4260,6 +4267,12 @@ gui_set_frame_parameters (struct frame *f, Lisp_Object alist) && XFIXNAT (param_index) < ARRAYELTS (frame_parms) && FRAME_RIF (f)->frame_parm_handlers[XFIXNUM (param_index)]) (*(FRAME_RIF (f)->frame_parm_handlers[XFIXNUM (param_index)])) (f, val, old_value); + + if (!default_parameter && EQ (prop, Qfont)) + /* The user manually specified the `font' frame parameter. + Save that parameter for future use by the + dynamic-setting code. */ + store_frame_param (f, Qfont_parameter, val); } } @@ -4410,6 +4423,11 @@ gui_set_frame_parameters (struct frame *f, Lisp_Object alist) SAFE_FREE (); } +void +gui_set_frame_parameters (struct frame *f, Lisp_Object alist) +{ + gui_set_frame_parameters_1 (f, alist, false); +} /* Insert a description of internally-recorded parameters of frame F into the parameter alist *ALISTPTR that is to be given to the user. @@ -4586,9 +4604,6 @@ gui_set_font (struct frame *f, Lisp_Object arg, Lisp_Object oldval) { Lisp_Object font_object; int fontset = -1; -#ifdef HAVE_X_WINDOWS - Lisp_Object font_param = arg; -#endif /* Set the frame parameter back to the old value because we may fail to use ARG as the new parameter value. */ @@ -4627,16 +4642,10 @@ gui_set_font (struct frame *f, Lisp_Object arg, Lisp_Object oldval) error ("Unknown fontset: %s", SDATA (XCAR (arg))); font_object = XCDR (arg); arg = AREF (font_object, FONT_NAME_INDEX); -#ifdef HAVE_X_WINDOWS - font_param = Ffont_get (font_object, QCname); -#endif } else if (FONT_OBJECT_P (arg)) { font_object = arg; -#ifdef HAVE_X_WINDOWS - font_param = Ffont_get (font_object, QCname); -#endif /* This is to store the XLFD font name in the frame parameter for backward compatibility. We should store the font-object itself in the future. */ @@ -4667,9 +4676,7 @@ gui_set_font (struct frame *f, Lisp_Object arg, Lisp_Object oldval) if (FRAME_TERMINAL (f)->set_new_font_hook) FRAME_TERMINAL (f)->set_new_font_hook (f, font_object, fontset); store_frame_param (f, Qfont, arg); -#ifdef HAVE_X_WINDOWS - store_frame_param (f, Qfont_parameter, font_param); -#endif + /* Recalculate tabbar height. */ f->n_tab_bar_rows = 0; /* Recalculate toolbar height. */ @@ -4749,7 +4756,7 @@ gui_set_font_backend (struct frame *f, Lisp_Object new_value, Lisp_Object old_va if (FRAME_FONT (f)) { /* Reconsider default font after backend(s) change (Bug#23386). */ - FRAME_RIF(f)->default_font_parameter (f, Qnil); + FRAME_RIF (f)->default_font_parameter (f, Qnil); face_change = true; windows_or_buffers_changed = 18; } @@ -5451,12 +5458,20 @@ gui_default_parameter (struct frame *f, Lisp_Object alist, Lisp_Object prop, enum resource_types type) { Lisp_Object tem; + bool was_unbound; tem = gui_frame_get_arg (f, alist, prop, xprop, xclass, type); + if (BASE_EQ (tem, Qunbound)) - tem = deflt; + { + tem = deflt; + was_unbound = true; + } + else + was_unbound = false; + AUTO_FRAME_ARG (arg, prop, tem); - gui_set_frame_parameters (f, arg); + gui_set_frame_parameters_1 (f, arg, was_unbound); return tem; } @@ -5946,6 +5961,67 @@ This function is for internal use only. */) return f->was_invisible ? Qt : Qnil; } + +#ifdef HAVE_WINDOW_SYSTEM + +DEFUN ("reconsider-frame-fonts", Freconsider_frame_fonts, + Sreconsider_frame_fonts, 1, 1, 0, + doc: /* Recreate FRAME's default font using updated font parameters. +Signal an error if FRAME is not a window system frame. This should be +called after a `config-changed' event is received, signaling that the +parameters (such as pixel density) used by the system to open fonts +have changed. */) + (Lisp_Object frame) +{ + struct frame *f; + Lisp_Object params, font_parameter; + + f = decode_window_system_frame (frame); + + /* Kludge: if a `font' parameter was already specified, + create an alist containing just that parameter. (bug#59371) + + This sounds so simple, right? Well, read on below: */ + params = Qnil; + + /* The difference between Qfont and Qfont_parameter is that the + latter is not set automatically by the likes of x_new_font, and + implicitly as the default face is realized. It is only set when + the user specifically specifies a `font' frame parameter, and is + cleared the moment the frame's font becomes defined by a face + attribute, instead of through the `font' frame parameter. */ + font_parameter = get_frame_param (f, Qfont_parameter); + + if (!NILP (font_parameter)) + params = list1 (Fcons (Qfont, font_parameter)); + + /* First, call this to reinitialize any font backend specific + stuff. */ + + if (FRAME_RIF (f)->default_font_parameter) + FRAME_RIF (f)->default_font_parameter (f, params); + + /* For a mysterious reason, x_default_font_parameter sets Qfont to + nil in the alist! */ + + if (!NILP (font_parameter)) + params = list1 (Fcons (Qfont, font_parameter)); + + /* Now call this to apply the existing value(s) of the `default' + face. */ + call2 (Qface_set_after_frame_default, frame, params); + + /* Restore the value of the `font-parameter' parameter, as + `face-set-after-frame-default' will have changed it through its + calls to `set-face-attribute'. */ + if (!NILP (font_parameter)) + store_frame_param (f, Qfont_parameter, font_parameter); + + return Qnil; +} + +#endif + /*********************************************************************** Multimonitor data @@ -6201,6 +6277,7 @@ syms_of_frame (void) DEFSYM (Qiconify_top_level, "iconify-top-level"); DEFSYM (Qmake_invisible, "make-invisible"); DEFSYM (Quse_frame_synchronization, "use-frame-synchronization"); + DEFSYM (Qfont_parameter, "font-parameter"); { int i; @@ -6634,6 +6711,6 @@ iconify the top level frame instead. */); #ifdef HAVE_WINDOW_SYSTEM defsubr (&Sx_get_resource); defsubr (&Sx_parse_geometry); + defsubr (&Sreconsider_frame_fonts); #endif - } diff --git a/src/frame.h b/src/frame.h index 458b6257e49..d6fd62b2ac2 100644 --- a/src/frame.h +++ b/src/frame.h @@ -1670,6 +1670,7 @@ IMAGE_OPT_FROM_ID (struct frame *f, int id) /* The class of this X application. */ #define EMACS_CLASS "Emacs" +extern void gui_set_frame_parameters_1 (struct frame *, Lisp_Object, bool); extern void gui_set_frame_parameters (struct frame *, Lisp_Object); extern void gui_set_fullscreen (struct frame *, Lisp_Object, Lisp_Object); extern void gui_set_line_spacing (struct frame *, Lisp_Object, Lisp_Object); diff --git a/src/ftcrfont.c b/src/ftcrfont.c index dc765e5aee4..ede8f1323cd 100644 --- a/src/ftcrfont.c +++ b/src/ftcrfont.c @@ -737,7 +737,7 @@ struct font_driver const ftcrfont_driver = .filter_properties = ftfont_filter_properties, .combining_capability = ftfont_combining_capability, #ifdef HAVE_PGTK - .cached_font_ok = ftcrfont_cached_font_ok + .cached_font_ok = ftcrfont_cached_font_ok, #endif }; #ifdef HAVE_HARFBUZZ @@ -755,6 +755,42 @@ syms_of_ftcrfont (void) pdumper_do_now_and_after_load (syms_of_ftcrfont_for_pdumper); } +#ifdef HAVE_X_WINDOWS + +/* Place the default font options used by Cairo on the given display + in OPTIONS. */ + +void +ftcrfont_get_default_font_options (struct x_display_info *dpyinfo, + cairo_font_options_t *options) +{ + Pixmap drawable; + cairo_surface_t *surface; + + /* Cairo doesn't allow fetching the default font options for a + display, so the only option is to create a drawable, and an Xlib + surface for that drawable, and to get the font options from there + instead. */ + + drawable = XCreatePixmap (dpyinfo->display, dpyinfo->root_window, + 1, 1, dpyinfo->n_planes); + surface = cairo_xlib_surface_create (dpyinfo->display, drawable, + dpyinfo->visual, 1, 1); + + if (!surface) + { + XFreePixmap (dpyinfo->display, drawable); + return; + } + + cairo_surface_get_font_options (surface, options); + XFreePixmap (dpyinfo->display, drawable); + cairo_surface_destroy (surface); + return; +} + +#endif + static void syms_of_ftcrfont_for_pdumper (void) { diff --git a/src/ftfont.h b/src/ftfont.h index cfab8d3154f..ee56e2d7608 100644 --- a/src/ftfont.h +++ b/src/ftfont.h @@ -84,4 +84,11 @@ struct font_info #endif }; +#if defined USE_CAIRO && defined HAVE_X_WINDOWS + +extern void ftcrfont_get_default_font_options (struct x_display_info *, + cairo_font_options_t *); + +#endif /* USE_CAIRO && HAVE_X_WINDOWS */ + #endif /* EMACS_FTFONT_H */ diff --git a/src/haiku_support.cc b/src/haiku_support.cc index 0f8e26d0db4..3a982856777 100644 --- a/src/haiku_support.cc +++ b/src/haiku_support.cc @@ -653,6 +653,24 @@ public: Quit (); else if (msg->what == B_CLIPBOARD_CHANGED) haiku_write (CLIPBOARD_CHANGED_EVENT, &rq); + else if (msg->what == B_KEY_MAP_LOADED) + { + /* Install the new keymap. Or rather, clear key_map -- Emacs + will fetch it again from the main thread the next time it + is needed. */ + if (key_map_lock.Lock ()) + { + if (key_map) + free (key_map); + + if (key_chars) + free (key_chars); + + key_map = NULL; + key_chars = NULL; + key_map_lock.Unlock (); + } + } else BApplication::MessageReceived (msg); } diff --git a/src/haiku_support.h b/src/haiku_support.h index e940e69bf11..2605a75b400 100644 --- a/src/haiku_support.h +++ b/src/haiku_support.h @@ -383,7 +383,7 @@ struct haiku_font_pattern /* The number of characters in `wanted_chars'. */ int want_chars_len; - /* List of characters. The font must fullfill at least one of + /* List of characters. The font must fulfill at least one of them for the match to succeed. */ int *need_one_of; diff --git a/src/haikufns.c b/src/haikufns.c index 711202c5df3..5717d0354f8 100644 --- a/src/haikufns.c +++ b/src/haikufns.c @@ -175,10 +175,19 @@ haiku_change_tool_bar_height (struct frame *f, int height) void haiku_change_tab_bar_height (struct frame *f, int height) { - int unit = FRAME_LINE_HEIGHT (f); - int old_height = FRAME_TAB_BAR_HEIGHT (f); - int lines = (height + unit - 1) / unit; - Lisp_Object fullscreen = get_frame_param (f, Qfullscreen); + int unit, old_height, lines; + Lisp_Object fullscreen; + + unit = FRAME_LINE_HEIGHT (f); + old_height = FRAME_TAB_BAR_HEIGHT (f); + fullscreen = get_frame_param (f, Qfullscreen); + + /* This differs from the tool bar code in that the tab bar height is + not rounded up. Otherwise, if redisplay_tab_bar decides to grow + the tab bar by even 1 pixel, FRAME_TAB_BAR_LINES will be changed, + leading to the tab bar height being incorrectly set upon the next + call to x_set_font. (bug#59285) */ + lines = height / unit; /* Make sure we redisplay all windows in this frame. */ fset_redisplay (f); diff --git a/src/haikuselect.c b/src/haikuselect.c index bd004f4900a..e8d3b5f0f7f 100644 --- a/src/haikuselect.c +++ b/src/haikuselect.c @@ -1260,7 +1260,7 @@ syms_of_haikuselect (void) { DEFVAR_BOOL ("haiku-signal-invalid-refs", haiku_signal_invalid_refs, doc: /* If nil, silently ignore invalid file names in system messages. -Otherwise, an error will be signalled if adding a file reference to a +Otherwise, an error will be signaled if adding a file reference to a system message failed. */); haiku_signal_invalid_refs = true; diff --git a/src/haikuterm.c b/src/haikuterm.c index 4e32b747160..496480cbc09 100644 --- a/src/haikuterm.c +++ b/src/haikuterm.c @@ -3007,9 +3007,11 @@ haiku_default_font_parameter (struct frame *f, Lisp_Object parms) font = font_open_by_spec (f, Ffont_get_system_font ()); if (NILP (font)) - font = !NILP (font_param) ? font_param - : gui_display_get_arg (dpyinfo, parms, Qfont, "font", "Font", - RES_TYPE_STRING); + font = (!NILP (font_param) + ? font_param + : gui_display_get_arg (dpyinfo, parms, Qfont, + "font", "Font", + RES_TYPE_STRING)); if (! FONTP (font) && ! STRINGP (font)) { @@ -3029,13 +3031,6 @@ haiku_default_font_parameter (struct frame *f, Lisp_Object parms) if (NILP (font)) error ("No suitable font was found"); } - else if (!NILP (font_param)) - { - /* Remember the explicit font parameter, so we can re-apply it - after we've applied the `default' face settings. */ - AUTO_FRAME_ARG (arg, Qfont_parameter, font_param); - gui_set_frame_parameters (f, arg); - } gui_default_parameter (f, parms, Qfont, font, "font", "Font", RES_TYPE_STRING); diff --git a/src/itree.c b/src/itree.c index 989173db4e5..04fa9e827a2 100644 --- a/src/itree.c +++ b/src/itree.c @@ -70,7 +70,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ but not the END. The previous/next overlay change operations need to find the nearest point where there is *either* an interval BEG or END point, but there is no efficient way to narrow the search - space over END postions. + space over END positions. Consider the case where next-overlay-change is called at POS, all interval BEG positions are less than pos POS and all interval END @@ -111,7 +111,7 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ In order to avoid this, we introduce yet another node attribute, called OFFSET. - The OFFSET of some some subtree, represented by its root, is the + The OFFSET of some subtree, represented by its root, is the amount of shift that needs to be applied to its BEGIN, END and LIMIT values, in order to get to the actual buffer positions. Coming back to the example, all we would need to do in this case, @@ -131,43 +131,20 @@ along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. */ * | Stack * +=======================================================================+ */ -typedef uintptr_t nodeptr_and_flag; - -static inline nodeptr_and_flag -make_nav (struct itree_node *ptr, bool flag) -{ - uintptr_t v = (uintptr_t) ptr; - /* We assume alignment imposes the LSB is clear for us to use it. */ - eassert (!(v & 1)); - return v | !!flag; -} - -static inline struct itree_node * -nav_nodeptr (nodeptr_and_flag nav) -{ - return (struct itree_node *) (nav & (~(uintptr_t)1)); -} - -static inline bool -nav_flag (nodeptr_and_flag nav) -{ - return (bool) (nav & 1); -} - /* Simple dynamic array. */ -struct interval_stack +struct itree_stack { - nodeptr_and_flag *nodes; + struct itree_node **nodes; size_t size; size_t length; }; /* This is just a simple dynamic array with stack semantics. */ -static struct interval_stack* -interval_stack_create (intmax_t initial_size) +static struct itree_stack* +itree_stack_create (intmax_t initial_size) { - struct interval_stack *stack = xmalloc (sizeof (struct interval_stack)); + struct itree_stack *stack = xmalloc (sizeof (struct itree_stack)); stack->size = max (0, initial_size); stack->nodes = xmalloc (stack->size * sizeof (struct itree_node*)); stack->length = 0; @@ -175,7 +152,7 @@ interval_stack_create (intmax_t initial_size) } static void -interval_stack_destroy (struct interval_stack *stack) +itree_stack_destroy (struct itree_stack *stack) { if (! stack) return; @@ -184,14 +161,8 @@ interval_stack_destroy (struct interval_stack *stack) xfree (stack); } -static void -interval_stack_clear (struct interval_stack *stack) -{ - stack->length = 0; -} - static inline void -interval_stack_ensure_space (struct interval_stack *stack, uintmax_t nelements) +itree_stack_ensure_space (struct itree_stack *stack, uintmax_t nelements) { if (nelements > stack->size) { @@ -204,104 +175,32 @@ interval_stack_ensure_space (struct interval_stack *stack, uintmax_t nelements) /* Push NODE on the STACK, while settings its visited flag to FLAG. */ static inline void -interval_stack_push_flagged (struct interval_stack *stack, - struct itree_node *node, bool flag) +itree_stack_push (struct itree_stack *stack, struct itree_node *node) { eassert (node); + itree_stack_ensure_space (stack, stack->length + 1); - /* FIXME: While the stack used in the iterator is bounded by the tree - depth and could be easily pre-allocated to a large enough size to avoid - this "ensure" check, `interval_stack_push` is also used elsewhere to - simply collect some subset of the overlays, where it's only bounded by - the total number of overlays in the buffer (which can be large and thus - preferably not pre-allocated needlessly). */ - interval_stack_ensure_space (stack, stack->length + 1); - - stack->nodes[stack->length] = make_nav (node, flag); + stack->nodes[stack->length] = node; stack->length++; } -static inline void -interval_stack_push (struct interval_stack *stack, struct itree_node *node) -{ - interval_stack_push_flagged (stack, node, false); -} - -static inline nodeptr_and_flag -interval_stack_pop (struct interval_stack *stack) +static inline struct itree_node * +itree_stack_pop (struct itree_stack *stack) { if (stack->length == 0) - return make_nav (NULL, false); + return NULL; return stack->nodes[--stack->length]; } /* +-----------------------------------------------------------------------+ */ -/* State used when iterating interval. */ -struct itree_iterator -{ - struct interval_stack *stack; - ptrdiff_t begin; - ptrdiff_t end; - - /* A copy of the tree's `otick`. */ - uintmax_t otick; - enum itree_order order; - bool running; - const char *file; - int line; -}; - -/* Ideally, every iteration would use its own `iter` object, so we could - have several iterations active at the same time. In practice, iterations - are limited by the fact we don't allow modifying the tree at the same - time, making the use of nested iterations quite rare anyway. - So we just use a single global iterator instead for now. */ -static struct itree_iterator *iter = NULL; - static int -interval_tree_max_height (const struct itree_tree *tree) +itree_max_height (const struct itree_tree *tree) { return 2 * log (tree->size + 1) / log (2) + 0.5; } -/* Allocate a new iterator for TREE. */ - -static struct itree_iterator * -itree_iterator_create (struct itree_tree *tree) -{ - struct itree_iterator *g = xmalloc (sizeof *g); - /* 19 here just avoids starting with a silly-small stack. - FIXME: Since this stack only needs to be about 2*max_depth - in the worst case, we could completely pre-allocate it to something - like word-bit-size * 2 and then never worry about growing it. */ - const int size = (tree ? interval_tree_max_height (tree) : 19) + 1; - - g->stack = interval_stack_create (size); - g->running = false; - g->begin = 0; - g->end = 0; - g->file = NULL; - g->line = 0; - return g; -} - -void -init_itree (void) -{ - eassert (!iter); - iter = itree_iterator_create (NULL); -} - -#ifdef HAVE_UNEXEC -void -forget_itree (void) -{ - iter = NULL; -} -#endif - struct check_subtree_result { /* Node count of the tree. */ @@ -334,7 +233,7 @@ check_subtree (struct itree_node *node, and <= to its parent's otick. Note: we cannot assert that (NODE.otick == NODE.parent.otick) - implies (NODE.offset == 0) because interval_tree_inherit_offset() + implies (NODE.offset == 0) because itree_inherit_offset() doesn't always update otick. It could, but it is not clear there is a need. */ eassert (node->otick <= tree_otick); @@ -438,7 +337,7 @@ itree_newlimit (struct itree_node *node) /* Update NODE's limit attribute according to its children. */ static void -interval_tree_update_limit (struct itree_node *node) +itree_update_limit (struct itree_node *node) { if (node == NULL) return; @@ -453,7 +352,7 @@ interval_tree_update_limit (struct itree_node *node) */ static void -interval_tree_inherit_offset (uintmax_t otick, struct itree_node *node) +itree_inherit_offset (uintmax_t otick, struct itree_node *node) { eassert (node->parent == NULL || node->parent->otick >= node->otick); if (node->otick == otick) @@ -490,7 +389,7 @@ interval_tree_inherit_offset (uintmax_t otick, struct itree_node *node) stable, i.e. new_limit = old_limit. */ static void -interval_tree_propagate_limit (struct itree_node *node) +itree_propagate_limit (struct itree_node *node) { ptrdiff_t newlimit; @@ -511,15 +410,15 @@ interval_tree_propagate_limit (struct itree_node *node) } static struct itree_node* -interval_tree_validate (struct itree_tree *tree, struct itree_node *node) +itree_validate (struct itree_tree *tree, struct itree_node *node) { if (tree->otick == node->otick || node == NULL) return node; if (node != tree->root) - interval_tree_validate (tree, node->parent); + itree_validate (tree, node->parent); - interval_tree_inherit_offset (tree->otick, node); + itree_inherit_offset (tree->otick, node); return node; } @@ -550,7 +449,7 @@ ptrdiff_t itree_node_begin (struct itree_tree *tree, struct itree_node *node) { - interval_tree_validate (tree, node); + itree_validate (tree, node); return node->begin; } @@ -560,7 +459,7 @@ ptrdiff_t itree_node_end (struct itree_tree *tree, struct itree_node *node) { - interval_tree_validate (tree, node); + itree_validate (tree, node); return node->end; } @@ -588,7 +487,7 @@ itree_clear (struct itree_tree *tree) /* Initialize a pre-allocated tree (presumably on the stack). */ static void -interval_tree_init (struct itree_tree *tree) +itree_init (struct itree_tree *tree) { itree_clear (tree); } @@ -613,15 +512,15 @@ itree_size (struct itree_tree *tree) /* Perform the familiar left-rotation on node NODE. */ static void -interval_tree_rotate_left (struct itree_tree *tree, +itree_rotate_left (struct itree_tree *tree, struct itree_node *node) { eassert (node->right != NULL); struct itree_node *right = node->right; - interval_tree_inherit_offset (tree->otick, node); - interval_tree_inherit_offset (tree->otick, right); + itree_inherit_offset (tree->otick, node); + itree_inherit_offset (tree->otick, right); /* Turn right's left subtree into node's right subtree. */ node->right = right->left; @@ -649,22 +548,22 @@ interval_tree_rotate_left (struct itree_tree *tree, node->parent = right; /* Order matters here. */ - interval_tree_update_limit (node); - interval_tree_update_limit (right); + itree_update_limit (node); + itree_update_limit (right); } /* Perform the familiar right-rotation on node NODE. */ static void -interval_tree_rotate_right (struct itree_tree *tree, +itree_rotate_right (struct itree_tree *tree, struct itree_node *node) { eassert (tree && node && node->left != NULL); struct itree_node *left = node->left; - interval_tree_inherit_offset (tree->otick, node); - interval_tree_inherit_offset (tree->otick, left); + itree_inherit_offset (tree->otick, node); + itree_inherit_offset (tree->otick, left); node->left = left->right; if (left->right != NULL) @@ -686,8 +585,8 @@ interval_tree_rotate_right (struct itree_tree *tree, if (node != NULL) node->parent = left; - interval_tree_update_limit (left); - interval_tree_update_limit (node); + itree_update_limit (left); + itree_update_limit (node); } /* Repair the tree after an insertion. @@ -695,7 +594,7 @@ interval_tree_rotate_right (struct itree_tree *tree, Rebalance the parents as needed to re-establish the RB invariants. */ static void -interval_tree_insert_fix (struct itree_tree *tree, +itree_insert_fix (struct itree_tree *tree, struct itree_node *node) { eassert (tree->root->red == false); @@ -729,12 +628,12 @@ interval_tree_insert_fix (struct itree_tree *tree, if (node == node->parent->right) /* case 2.a */ { node = node->parent; - interval_tree_rotate_left (tree, node); + itree_rotate_left (tree, node); } /* case 3.a */ node->parent->red = false; node->parent->parent->red = true; - interval_tree_rotate_right (tree, node->parent->parent); + itree_rotate_right (tree, node->parent->parent); } } else @@ -754,12 +653,12 @@ interval_tree_insert_fix (struct itree_tree *tree, if (node == node->parent->left) /* case 2.b */ { node = node->parent; - interval_tree_rotate_right (tree, node); + itree_rotate_right (tree, node); } /* case 3.b */ node->parent->red = false; node->parent->parent->red = true; - interval_tree_rotate_left (tree, node->parent->parent); + itree_rotate_left (tree, node->parent->parent); } } } @@ -771,22 +670,20 @@ interval_tree_insert_fix (struct itree_tree *tree, } /* Insert a NODE into the TREE. - Note, that inserting a node twice results in undefined behaviour. */ + Note, that inserting a node twice results in undefined behavior. */ static void -interval_tree_insert (struct itree_tree *tree, struct itree_node *node) +itree_insert_node (struct itree_tree *tree, struct itree_node *node) { eassert (node && node->begin <= node->end); - /* FIXME: The assertion below fails because `delete_all_overlays` - doesn't set left/right/parent to NULL. */ - /* eassert (node->left == NULL && node->right == NULL - && node->parent == NULL) */; + eassert (node->left == NULL && node->right == NULL + && node->parent == NULL); eassert (check_tree (tree, true)); /* FIXME: Too expensive. */ struct itree_node *parent = NULL; struct itree_node *child = tree->root; uintmax_t otick = tree->otick; - /* It's the responsability of the caller to set `otick` on the node, + /* It's the responsibility of the caller to set `otick` on the node, to "confirm" that the begin/end fields are up to date. */ eassert (node->otick == otick); @@ -794,7 +691,7 @@ interval_tree_insert (struct itree_tree *tree, struct itree_node *node) ancestors limit values. */ while (child != NULL) { - interval_tree_inherit_offset (otick, child); + itree_inherit_offset (otick, child); parent = child; eassert (child->offset == 0); child->limit = max (child->limit, node->end); @@ -827,7 +724,7 @@ interval_tree_insert (struct itree_tree *tree, struct itree_node *node) { node->red = true; eassert (check_tree (tree, false)); /* FIXME: Too expensive. */ - interval_tree_insert_fix (tree, node); + itree_insert_fix (tree, node); } } @@ -838,7 +735,7 @@ itree_insert (struct itree_tree *tree, struct itree_node *node, node->begin = begin; node->end = end; node->otick = tree->otick; - interval_tree_insert (tree, node); + itree_insert_node (tree, node); } /* Safely modify a node's interval. */ @@ -848,35 +745,32 @@ itree_node_set_region (struct itree_tree *tree, struct itree_node *node, ptrdiff_t begin, ptrdiff_t end) { - interval_tree_validate (tree, node); + itree_validate (tree, node); if (begin != node->begin) { itree_remove (tree, node); node->begin = min (begin, PTRDIFF_MAX - 1); node->end = max (node->begin, end); - interval_tree_insert (tree, node); + itree_insert_node (tree, node); } else if (end != node->end) { node->end = max (node->begin, end); eassert (node != NULL); - interval_tree_propagate_limit (node); + itree_propagate_limit (node); } } /* Return true, if NODE is a member of TREE. */ static bool -interval_tree_contains (struct itree_tree *tree, struct itree_node *node) +itree_contains (struct itree_tree *tree, struct itree_node *node) { - eassert (iter && node); + eassert (node); struct itree_node *other; ITREE_FOREACH (other, tree, node->begin, PTRDIFF_MAX, ASCENDING) if (other == node) - { - ITREE_FOREACH_ABORT (); - return true; - } + return true; return false; } @@ -891,11 +785,11 @@ itree_limit_is_stable (struct itree_node *node) } static struct itree_node* -interval_tree_subtree_min (uintmax_t otick, struct itree_node *node) +itree_subtree_min (uintmax_t otick, struct itree_node *node) { if (node == NULL) return node; - while ((interval_tree_inherit_offset (otick, node), + while ((itree_inherit_offset (otick, node), node->left != NULL)) node = node->left; return node; @@ -906,7 +800,7 @@ interval_tree_subtree_min (uintmax_t otick, struct itree_node *node) so re-balance the parents to re-establish the RB invariants. */ static void -interval_tree_remove_fix (struct itree_tree *tree, +itree_remove_fix (struct itree_tree *tree, struct itree_node *node, struct itree_node *parent) { @@ -927,7 +821,7 @@ interval_tree_remove_fix (struct itree_tree *tree, { other->red = false; parent->red = true; - interval_tree_rotate_left (tree, parent); + itree_rotate_left (tree, parent); other = parent->right; } eassume (other != NULL); @@ -946,13 +840,13 @@ interval_tree_remove_fix (struct itree_tree *tree, { other->left->red = false; other->red = true; - interval_tree_rotate_right (tree, other); + itree_rotate_right (tree, other); other = parent->right; } other->red = parent->red; /* 4.a */ parent->red = false; other->right->red = false; - interval_tree_rotate_left (tree, parent); + itree_rotate_left (tree, parent); node = tree->root; parent = NULL; } @@ -965,7 +859,7 @@ interval_tree_remove_fix (struct itree_tree *tree, { other->red = false; parent->red = true; - interval_tree_rotate_right (tree, parent); + itree_rotate_right (tree, parent); other = parent->left; } eassume (other != NULL); @@ -984,14 +878,14 @@ interval_tree_remove_fix (struct itree_tree *tree, { other->right->red = false; other->red = true; - interval_tree_rotate_left (tree, other); + itree_rotate_left (tree, other); other = parent->left; } other->red = parent->red; /* 4.b */ parent->red = false; other->left->red = false; - interval_tree_rotate_right (tree, parent); + itree_rotate_right (tree, parent); node = tree->root; parent = NULL; } @@ -1024,7 +918,7 @@ itree_total_offset (struct itree_node *node) unchanged. Caller is responsible for recalculation of `limit`. Requires both nodes to be using the same effective `offset`. */ static void -interval_tree_replace_child (struct itree_tree *tree, +itree_replace_child (struct itree_tree *tree, struct itree_node *source, struct itree_node *dest) { @@ -1050,11 +944,11 @@ interval_tree_replace_child (struct itree_tree *tree, recalculation of `limit`. Requires both nodes to be using the same effective `offset`. */ static void -interval_tree_transplant (struct itree_tree *tree, +itree_transplant (struct itree_tree *tree, struct itree_node *source, struct itree_node *dest) { - interval_tree_replace_child (tree, source, dest); + itree_replace_child (tree, source, dest); source->left = dest->left; if (source->left != NULL) source->left->parent = source; @@ -1069,17 +963,17 @@ interval_tree_transplant (struct itree_tree *tree, struct itree_node* itree_remove (struct itree_tree *tree, struct itree_node *node) { - eassert (interval_tree_contains (tree, node)); + eassert (itree_contains (tree, node)); eassert (check_tree (tree, true)); /* FIXME: Too expensive. */ /* Find `splice`, the leaf node to splice out of the tree. When `node` has at most one child this is `node` itself. Otherwise, it is the in order successor of `node`. */ - interval_tree_inherit_offset (tree->otick, node); + itree_inherit_offset (tree->otick, node); struct itree_node *splice = (node->left == NULL || node->right == NULL) ? node - : interval_tree_subtree_min (tree->otick, node->right); + : itree_subtree_min (tree->otick, node->right); /* Find `subtree`, the only child of `splice` (may be NULL). Note: `subtree` will not be modified other than changing its parent to @@ -1100,7 +994,7 @@ itree_remove (struct itree_tree *tree, struct itree_node *node) `splice` is black, this creates a red-red violation, so remember this now as the field can be overwritten when splice is transplanted below. */ - interval_tree_replace_child (tree, subtree, splice); + itree_replace_child (tree, subtree, splice); bool removed_black = !splice->red; /* Replace `node` with `splice` in the tree and propagate limit @@ -1109,18 +1003,18 @@ itree_remove (struct itree_tree *tree, struct itree_node *node) has a new child. */ if (splice != node) { - interval_tree_transplant (tree, splice, node); - interval_tree_propagate_limit (subtree_parent); + itree_transplant (tree, splice, node); + itree_propagate_limit (subtree_parent); if (splice != subtree_parent) - interval_tree_update_limit (splice); + itree_update_limit (splice); } - interval_tree_propagate_limit (splice->parent); + itree_propagate_limit (splice->parent); --tree->size; /* Fix any black height violation caused by removing a black node. */ if (removed_black) - interval_tree_remove_fix (tree, subtree, subtree_parent); + itree_remove_fix (tree, subtree, subtree_parent); eassert ((tree->size == 0) == (tree->root == NULL)); eassert (check_tree (tree, true)); /* FIXME: Too expensive. */ @@ -1138,52 +1032,6 @@ itree_remove (struct itree_tree *tree, struct itree_node *node) return node; } -bool -itree_iterator_busy_p (void) -{ - return (iter && iter->running); -} - -/* Start a iterator enumerating all intervals in [BEGIN,END) in the - given ORDER. Only one iterator per tree can be running at any time. */ - -struct itree_iterator * -itree_iterator_start (struct itree_tree *tree, ptrdiff_t begin, - ptrdiff_t end, enum itree_order order, - const char *file, int line) -{ - eassert (iter); - if (iter->running) - { - fprintf (stderr, - "Detected nested iteration!\nOuter: %s:%d\nInner: %s:%d\n", - iter->file, iter->line, file, line); - emacs_abort (); - } - iter->begin = begin; - iter->end = end; - iter->otick = tree->otick; - iter->order = order; - interval_stack_clear (iter->stack); - if (begin <= end && tree->root != NULL) - interval_stack_push_flagged (iter->stack, tree->root, false); - iter->file = file; - iter->line = line; - iter->running = true; - /* interval_stack_ensure_space (iter->stack, - 2 * interval_tree_max_height (tree)); */ - return iter; -} - -/* Stop using the iterator. */ - -void -itree_iterator_finish (struct itree_iterator *iter) -{ - eassert (iter && iter->running); - iter->running = false; -} - /* +=======================================================================+ * | Insert/Delete Gaps @@ -1210,10 +1058,11 @@ itree_insert_gap (struct itree_tree *tree, order, so we need to remove them first. This doesn't apply for `before_markers` since in that case, all positions move identically regardless of `front_advance` or `rear_advance`. */ - struct interval_stack *saved = interval_stack_create (0); + struct itree_stack *saved = itree_stack_create (0); struct itree_node *node = NULL; if (!before_markers) { + /* Actually any order would do. */ ITREE_FOREACH (node, tree, pos, pos + 1, PRE_ORDER) { if (node->begin == pos && node->front_advance @@ -1221,25 +1070,23 @@ itree_insert_gap (struct itree_tree *tree, the overlay is empty, make sure we don't move begin past end by pretending it's !front_advance. */ && (node->begin != node->end || node->rear_advance)) - interval_stack_push (saved, node); + itree_stack_push (saved, node); } } for (size_t i = 0; i < saved->length; ++i) - itree_remove (tree, nav_nodeptr (saved->nodes[i])); + itree_remove (tree, saved->nodes[i]); /* We can't use an iterator here, because we can't effectively narrow AND shift some subtree at the same time. */ if (tree->root != NULL) { - const int size = interval_tree_max_height (tree) + 1; - struct interval_stack *stack = interval_stack_create (size); - interval_stack_push (stack, tree->root); - nodeptr_and_flag nav; - while ((nav = interval_stack_pop (stack), - node = nav_nodeptr (nav))) + const int size = itree_max_height (tree) + 1; + struct itree_stack *stack = itree_stack_create (size); + itree_stack_push (stack, tree->root); + while ((node = itree_stack_pop (stack))) { /* Process in pre-order. */ - interval_tree_inherit_offset (tree->otick, node); + itree_inherit_offset (tree->otick, node); if (pos > node->limit) continue; if (node->right != NULL) @@ -1251,10 +1098,10 @@ itree_insert_gap (struct itree_tree *tree, ++tree->otick; } else - interval_stack_push (stack, node->right); + itree_stack_push (stack, node->right); } if (node->left != NULL) - interval_stack_push (stack, node->left); + itree_stack_push (stack, node->left); if (before_markers ? node->begin >= pos @@ -1265,17 +1112,15 @@ itree_insert_gap (struct itree_tree *tree, { node->end += length; eassert (node != NULL); - interval_tree_propagate_limit (node); + itree_propagate_limit (node); } } - interval_stack_destroy (stack); + itree_stack_destroy (stack); } /* Reinsert nodes starting at POS having front-advance. */ uintmax_t notick = tree->otick; - nodeptr_and_flag nav; - while ((nav = interval_stack_pop (saved), - node = nav_nodeptr (nav))) + while ((node = itree_stack_pop (saved))) { eassert (node->otick == ootick); eassert (node->begin == pos); @@ -1283,10 +1128,10 @@ itree_insert_gap (struct itree_tree *tree, node->begin += length; node->end += length; node->otick = notick; - interval_tree_insert (tree, node); + itree_insert_node (tree, node); } - interval_stack_destroy (saved); + itree_stack_destroy (saved); } /* Delete a gap at POS of length LENGTH, contracting all intervals @@ -1303,16 +1148,14 @@ itree_delete_gap (struct itree_tree *tree, /* Can't use the iterator here, because by decrementing begin, we might unintentionally bring shifted nodes back into our search space. */ - const int size = interval_tree_max_height (tree) + 1; - struct interval_stack *stack = interval_stack_create (size); + const int size = itree_max_height (tree) + 1; + struct itree_stack *stack = itree_stack_create (size); struct itree_node *node; - interval_stack_push (stack, tree->root); - nodeptr_and_flag nav; - while ((nav = interval_stack_pop (stack))) + itree_stack_push (stack, tree->root); + while ((node = itree_stack_pop (stack))) { - node = nav_nodeptr (nav); - interval_tree_inherit_offset (tree->otick, node); + itree_inherit_offset (tree->otick, node); if (pos > node->limit) continue; if (node->right != NULL) @@ -1324,10 +1167,10 @@ itree_delete_gap (struct itree_tree *tree, ++tree->otick; } else - interval_stack_push (stack, node->right); + itree_stack_push (stack, node->right); } if (node->left != NULL) - interval_stack_push (stack, node->left); + itree_stack_push (stack, node->left); if (pos < node->begin) node->begin = max (pos, node->begin - length); @@ -1335,10 +1178,10 @@ itree_delete_gap (struct itree_tree *tree, { node->end = max (pos , node->end - length); eassert (node != NULL); - interval_tree_propagate_limit (node); + itree_propagate_limit (node); } } - interval_stack_destroy (stack); + itree_stack_destroy (stack); } @@ -1356,81 +1199,217 @@ itree_delete_gap (struct itree_tree *tree, a NODE2 strictly bigger than NODE1 should also be included). */ static inline bool -interval_node_intersects (const struct itree_node *node, - ptrdiff_t begin, ptrdiff_t end) +itree_node_intersects (const struct itree_node *node, + ptrdiff_t begin, ptrdiff_t end) { return (begin < node->end && node->begin < end) || (node->begin == node->end && begin == node->begin); } -/* Return the next node of the iterator in the order given when it was - started; or NULL if there are no more nodes. */ +/* Return the "next" node in the current traversal order. -struct itree_node * -itree_iterator_next (struct itree_iterator *g) -{ - eassert (g && g->running); + Note that this should return all the nodes that we need to traverse + in order to traverse the nodes selected by the current narrowing (i.e. + `ITER->begin..ITER->end`) so it will also return some nodes which aren't in + that narrowing simply because they may have children which are. - struct itree_node *const null = NULL; - struct itree_node *node; + The code itself is very unsatifactory because the code of each one + of the supported traversals seems completely different from the others. + If someone knows how to make it more uniform and "obviously correct", + please make yourself heard. */ - /* The `visited` flag stored in each node is used here (and only here): - We keep a "workstack" of nodes we need to consider. This stack - consist of nodes of two types: nodes that we have decided - should be returned by the iterator, and nodes which we may - need to consider (including checking their children). - We start an iteration with a stack containing just the root - node marked as "not visited" which means that it (and its children) - needs to be considered but we haven't yet decided whether it's included - in the iterator's output. */ - - do +static struct itree_node * +itree_iter_next_in_subtree (struct itree_node *node, + struct itree_iterator *iter) +{ + /* FIXME: Like in the previous version of the iterator, we + prune based on `limit` only when moving to a left child, + but `limit` can also get smaller when moving to a right child + It's actually fairly common, so maybe it would be worthwhile + to prune a bit more aggressively here. */ + struct itree_node *next; + switch (iter->order) { - nodeptr_and_flag nav; - bool visited; - while ((nav = interval_stack_pop (g->stack), - node = nav_nodeptr (nav), - visited = nav_flag (nav), - node && !visited)) - { - struct itree_node *const left = node->left; - struct itree_node *const right = node->right; + case ITREE_ASCENDING: + next = node->right; + if (!next) + { + while ((next = node->parent) + && next->right == node) + node = next; + if (!next) + return NULL; /* No more nodes to visit. */ + node = next; + } + else + { + node = next; + itree_inherit_offset (iter->otick, node); + while ((next = node->left) + && (itree_inherit_offset (iter->otick, next), + iter->begin <= next->limit)) + node = next; + } + if (node->begin > iter->end) + return NULL; /* No more nodes within begin..end. */ + return node; + + case ITREE_DESCENDING: + next = node->left; + if (!next + || (itree_inherit_offset (iter->otick, next), + next->limit < iter->begin)) + { + while ((next = node->parent) + && next->left == node) + node = next; + if (!next) + return NULL; /* No more nodes to visit. */ + node = next; + } + else + { + node = next; + while (node->begin <= iter->end + && (next = node->right)) + { + itree_inherit_offset (iter->otick, next), + node = next; + } + } + return node; + + case ITREE_PRE_ORDER: + next = node->left; + if (next + && (itree_inherit_offset (iter->otick, next), + !(next->limit < iter->begin))) + return next; + next = node->right; + if (node->begin <= iter->end && next) + { + itree_inherit_offset (iter->otick, next); + return next; + } + while ((next = node->parent)) + { + if (next->right == node) + node = next; + else + { + eassert (next->left == node); + node = next; + next = node->right; + if (node->begin <= iter->end && next) + { + itree_inherit_offset (iter->otick, next); + return next; + } + } + } + return NULL; + + case ITREE_POST_ORDER: + next = node->parent; + if (!next || next->right == node) + return next; + eassert (next->left == node); + node = next; + next = node->right; + if (!(node->begin <= iter->end && next)) + return node; + node = next; + itree_inherit_offset (iter->otick, node); + while (((next = node->left) + && (itree_inherit_offset (iter->otick, next), + iter->begin <= next->limit)) + || (node->begin <= iter->end + && (next = node->right) + && (itree_inherit_offset (iter->otick, next), true))) + node = next; + return node; + + default: + emacs_abort (); + } +} - interval_tree_inherit_offset (g->otick, node); - eassert (itree_limit_is_stable (node)); - switch (g->order) - { - case ITREE_ASCENDING: - if (right != null && node->begin <= g->end) - interval_stack_push_flagged (g->stack, right, false); - if (interval_node_intersects (node, g->begin, g->end)) - interval_stack_push_flagged (g->stack, node, true); - /* Node's children may still be off-set and we need to add it. */ - if (left != null && g->begin <= left->limit + left->offset) - interval_stack_push_flagged (g->stack, left, false); - break; - case ITREE_DESCENDING: - if (left != null && g->begin <= left->limit + left->offset) - interval_stack_push_flagged (g->stack, left, false); - if (interval_node_intersects (node, g->begin, g->end)) - interval_stack_push_flagged (g->stack, node, true); - if (right != null && node->begin <= g->end) - interval_stack_push_flagged (g->stack, right, false); - break; - case ITREE_PRE_ORDER: - if (right != null && node->begin <= g->end) - interval_stack_push_flagged (g->stack, right, false); - if (left != null && g->begin <= left->limit + left->offset) - interval_stack_push_flagged (g->stack, left, false); - if (interval_node_intersects (node, g->begin, g->end)) - interval_stack_push_flagged (g->stack, node, true); - break; - } - } - /* Node may have been invalidated by itree_iterator_narrow - after it was pushed: Check if it still intersects. */ - } while (node && ! interval_node_intersects (node, g->begin, g->end)); +static struct itree_node * +itree_iterator_first_node (struct itree_tree *tree, + struct itree_iterator *iter) +{ + struct itree_node *node = tree->root; + if (node) + { + struct itree_node dummy; + dummy.left = NULL; + dummy.parent = NULL; + dummy.right = NULL; + itree_inherit_offset (iter->otick, node); + switch (iter->order) + { + case ITREE_ASCENDING: + dummy.right = node; + dummy.begin = PTRDIFF_MIN; + node = itree_iter_next_in_subtree (&dummy, iter); + break; + + case ITREE_DESCENDING: + dummy.left = node; + node = itree_iter_next_in_subtree (&dummy, iter); + break; + + case ITREE_PRE_ORDER: + break; + + case ITREE_POST_ORDER: + dummy.parent = &dummy; + dummy.left = &dummy; + dummy.right = node; + dummy.begin = PTRDIFF_MIN; + node = itree_iter_next_in_subtree (&dummy, iter); + break; + default: + emacs_abort (); + } + } + return node; +} + +/* Start a iterator enumerating all intervals in [BEGIN,END) in the + given ORDER. */ + +struct itree_iterator * +itree_iterator_start (struct itree_iterator *iter, + struct itree_tree *tree, + ptrdiff_t begin, ptrdiff_t end, enum itree_order order) +{ + eassert (iter); + iter->begin = begin; + iter->end = end; + iter->otick = tree->otick; + iter->order = order; + /* Beware: the `node` field always holds "the next" node to consider. + so it's always "one node ahead" of what the iterator loop sees. + In most respects this makes no difference, but we depend on this + detail in `delete_all_overlays` where this allows us to modify + the current node knowing that the iterator will not need it to + find the next. */ + iter->node = itree_iterator_first_node (tree, iter); + return iter; +} +struct itree_node * +itree_iterator_next (struct itree_iterator *iter) +{ + struct itree_node *node = iter->node; + while (node + && !itree_node_intersects (node, iter->begin, iter->end)) + { + node = itree_iter_next_in_subtree (node, iter); + eassert (itree_limit_is_stable (node)); + } + iter->node = node ? itree_iter_next_in_subtree (node, iter) : NULL; return node; } @@ -1441,7 +1420,7 @@ void itree_iterator_narrow (struct itree_iterator *g, ptrdiff_t begin, ptrdiff_t end) { - eassert (g && g->running); + eassert (g); eassert (begin >= g->begin); eassert (end <= g->end); g->begin = max (begin, g->begin); diff --git a/src/itree.h b/src/itree.h index 10ee0897c37..291fa53fd30 100644 --- a/src/itree.h +++ b/src/itree.h @@ -104,12 +104,9 @@ enum itree_order ITREE_ASCENDING, ITREE_DESCENDING, ITREE_PRE_ORDER, + ITREE_POST_ORDER, }; -extern void init_itree (void); -#ifdef HAVE_UNEXEC -extern void forget_itree (void); -#endif extern void itree_node_init (struct itree_node *, bool, bool, Lisp_Object); extern ptrdiff_t itree_node_begin (struct itree_tree *, struct itree_node *); extern ptrdiff_t itree_node_end (struct itree_tree *, struct itree_node *); @@ -128,20 +125,28 @@ extern void itree_delete_gap (struct itree_tree *, ptrdiff_t, ptrdiff_t); /* Iteration functions. Almost all code should use ITREE_FOREACH instead. */ -extern bool itree_iterator_busy_p (void); -extern struct itree_iterator *itree_iterator_start (struct itree_tree *, +extern struct itree_iterator *itree_iterator_start (struct itree_iterator *, + struct itree_tree *, ptrdiff_t, ptrdiff_t, - enum itree_order, - const char *, int); + enum itree_order); extern void itree_iterator_narrow (struct itree_iterator *, ptrdiff_t, ptrdiff_t); -extern void itree_iterator_finish (struct itree_iterator *); extern struct itree_node *itree_iterator_next (struct itree_iterator *); +/* State used when iterating interval. */ +struct itree_iterator + { + struct itree_node *node; + ptrdiff_t begin; + ptrdiff_t end; + uintmax_t otick; /* A copy of the tree's `otick`. */ + enum itree_order order; + }; + /* Iterate over the intervals between BEG and END in the tree T. N will hold successive nodes. ORDER can be one of : `ASCENDING`, - `DESCENDING`, or `PRE_ORDER`. + `DESCENDING`, `POST_ORDER`, or `PRE_ORDER`. It should be used as: ITREE_FOREACH (n, t, beg, end, order) @@ -152,33 +157,23 @@ extern struct itree_node *itree_iterator_next (struct itree_iterator *); BEWARE: - The expression T may be evaluated more than once, so make sure it is cheap and pure. - - Only a single iteration can happen at a time, so make sure none of the - code within the loop can start another tree iteration, i.e. it shouldn't - be able to run ELisp code, nor GC since GC can run ELisp by way - of `post-gc-hook`. - - If you need to exit the loop early, you *have* to call `ITREE_ABORT` - just before exiting (e.g. with `break` or `return`). - - Non-local exits are not supported within the body of the loop. - Don't modify the tree during the iteration. */ #define ITREE_FOREACH(n, t, beg, end, order) \ - /* FIXME: We'd want to declare `x` right here, but I can't figure out + /* FIXME: We'd want to declare `n` right here, but I can't figure out how to make that work here: the `for` syntax only allows a single clause for the var declarations where we need 2 different types. We could use the `struct {foo x; bar y; } p;` trick to declare two vars `p.x` and `p.y` of unrelated types, but then none of the names - of the vars matches the `n` we receive :-(. */ \ - if (!t) \ - { } \ - else \ - for (struct itree_iterator *itree_iter_ \ - = itree_iterator_start (t, beg, end, ITREE_##order, \ - __FILE__, __LINE__); \ - ((n = itree_iterator_next (itree_iter_)) \ - || (itree_iterator_finish (itree_iter_), false));) - -#define ITREE_FOREACH_ABORT() \ - itree_iterator_finish (itree_iter_) + of the vars matches the `n` we receive :-(. */ \ + if (!t) \ + { } \ + else \ + for (struct itree_iterator itree_local_iter_, \ + *itree_iter_ \ + = itree_iterator_start (&itree_local_iter_, \ + t, beg, end, ITREE_##order); \ + ((n = itree_iterator_next (itree_iter_)));) #define ITREE_FOREACH_NARROW(beg, end) \ itree_iterator_narrow (itree_iter_, beg, end) diff --git a/src/keyboard.c b/src/keyboard.c index 069cf0627b2..811998823cc 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -5720,6 +5720,29 @@ make_scroll_bar_position (struct input_event *ev, Lisp_Object type) builtin_lisp_symbol (scroll_bar_parts[ev->part])); } +#if defined HAVE_WINDOW_SYSTEM && !defined HAVE_EXT_MENU_BAR + +/* Return whether or not the coordinates X and Y are inside the + box of the menu-bar window of frame F. */ + +static bool +coords_in_menu_bar_window (struct frame *f, int x, int y) +{ + struct window *window; + + if (!WINDOWP (f->menu_bar_window)) + return false; + + window = XWINDOW (f->menu_bar_window); + + return (y >= WINDOW_TOP_EDGE_Y (window) + && x >= WINDOW_LEFT_EDGE_X (window) + && y <= WINDOW_BOTTOM_EDGE_Y (window) + && x <= WINDOW_RIGHT_EDGE_X (window)); +} + +#endif + /* Given a struct input_event, build the lisp event which represents it. If EVENT is 0, build a mouse movement event from the mouse movement buffer, which should have a movement event in it. @@ -5972,10 +5995,32 @@ make_lispy_event (struct input_event *event) and ROW are set to frame relative glyph coordinates which are then used to determine whether this click is in a menu (non-toolkit version). */ - if (!toolkit_menubar_in_use (f)) + if (!toolkit_menubar_in_use (f) +#if defined HAVE_WINDOW_SYSTEM && !defined HAVE_EXT_MENU_BAR + /* Don't process events for menu bars if they are not + in the menu bar window. */ + && (!FRAME_WINDOW_P (f) + || coords_in_menu_bar_window (f, XFIXNUM (event->x), + XFIXNUM (event->y))) +#endif + ) { - pixel_to_glyph_coords (f, XFIXNUM (event->x), XFIXNUM (event->y), - &column, &row, NULL, 1); +#if defined HAVE_WINDOW_SYSTEM && !defined HAVE_EXT_MENU_BAR + if (FRAME_WINDOW_P (f)) + { + struct window *menu_w = XWINDOW (f->menu_bar_window); + int x, y, dummy; + + x = FRAME_TO_WINDOW_PIXEL_X (menu_w, XFIXNUM (event->x)); + y = FRAME_TO_WINDOW_PIXEL_Y (menu_w, XFIXNUM (event->y)); + + x_y_to_hpos_vpos (XWINDOW (f->menu_bar_window), x, y, &column, &row, + NULL, NULL, &dummy); + } + else +#endif + pixel_to_glyph_coords (f, XFIXNUM (event->x), XFIXNUM (event->y), + &column, &row, NULL, 1); /* In the non-toolkit version, clicks on the menu bar are ordinary button events in the event buffer. @@ -5985,7 +6030,7 @@ make_lispy_event (struct input_event *event) menu bar and Emacs doesn't know about it until after the user makes a selection.) */ if (row >= 0 && row < FRAME_MENU_BAR_LINES (f) - && (event->modifiers & down_modifier)) + && (event->modifiers & down_modifier)) { Lisp_Object items, item; diff --git a/src/lread.c b/src/lread.c index 957bc6895ef..2a57f721943 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1741,12 +1741,15 @@ maybe_swap_for_eln (bool no_native, Lisp_Object *filename, int *fd, Vload_path, Qnil, Qnil))) return; - call2 (intern_c_string ("display-warning"), - Qcomp, - CALLN (Fformat, - build_string ("Cannot look up eln file as " - "no source file was found for %s"), - *filename)); + Vdelayed_warnings_list + = Fcons (list2 + (Qcomp, + CALLN (Fformat, + build_string ("Cannot look up eln " + "file as no source file " + "was found for %s"), + *filename)), + Vdelayed_warnings_list); return; } } @@ -5620,7 +5623,8 @@ from the file, and matches them against this regular expression. When the regular expression matches, the file is considered to be safe to load. */); Vbytecomp_version_regexp - = build_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)"); + = build_pure_c_string + ("^;;;.\\(?:in Emacs version\\|bytecomp version FSF\\)"); DEFSYM (Qlexical_binding, "lexical-binding"); DEFVAR_LISP ("lexical-binding", Vlexical_binding, diff --git a/src/nsfns.m b/src/nsfns.m index 2699cf37a5b..d793bcf13ff 100644 --- a/src/nsfns.m +++ b/src/nsfns.m @@ -632,10 +632,19 @@ ns_set_menu_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) void ns_change_tab_bar_height (struct frame *f, int height) { - int unit = FRAME_LINE_HEIGHT (f); - int old_height = FRAME_TAB_BAR_HEIGHT (f); - int lines = (height + unit - 1) / unit; - Lisp_Object fullscreen = get_frame_param (f, Qfullscreen); + int unit, old_height, lines; + Lisp_Object fullscreen; + + unit = FRAME_LINE_HEIGHT (f); + old_height = FRAME_TAB_BAR_HEIGHT (f); + fullscreen = get_frame_param (f, Qfullscreen); + + /* This differs from the tool bar code in that the tab bar height is + not rounded up. Otherwise, if redisplay_tab_bar decides to grow + the tab bar by even 1 pixel, FRAME_TAB_BAR_LINES will be changed, + leading to the tab bar height being incorrectly set upon the next + call to x_set_font. (bug#59285) */ + lines = height / unit; /* Make sure we redisplay all windows in this frame. */ fset_redisplay (f); diff --git a/src/nsimage.m b/src/nsimage.m index 9cb5090dd0d..dd8768664a4 100644 --- a/src/nsimage.m +++ b/src/nsimage.m @@ -74,8 +74,10 @@ ns_can_use_native_image_api (Lisp_Object type) imageType = @"com.compuserve.gif"; else if (EQ (type, Qtiff)) imageType = @"public.tiff"; +#ifndef HAVE_RSVG else if (EQ (type, Qsvg)) imageType = @"public.svg-image"; +#endif else if (EQ (type, Qheic)) imageType = @"public.heic"; diff --git a/src/nsterm.m b/src/nsterm.m index 17f40dc7e37..507f2a9e7da 100644 --- a/src/nsterm.m +++ b/src/nsterm.m @@ -7056,6 +7056,36 @@ ns_create_font_panel_buttons (id target, SEL select, SEL cancel_action) processingCompose = NO; } +static Lisp_Object +ns_in_echo_area_1 (void *ptr) +{ + Lisp_Object in_echo_area; + specpdl_ref count; + + count = SPECPDL_INDEX (); + specbind (Qinhibit_quit, Qt); + in_echo_area = safe_call (1, Qns_in_echo_area); + + return unbind_to (count, in_echo_area); +} + +static Lisp_Object +ns_in_echo_area_2 (enum nonlocal_exit exit, Lisp_Object error) +{ + return Qnil; +} + +static bool +ns_in_echo_area (void) +{ + Lisp_Object in_echo_area; + + in_echo_area + = internal_catch_all (ns_in_echo_area_1, NULL, + ns_in_echo_area_2); + + return !NILP (in_echo_area); +} /* Used to position char selection windows, etc. */ - (NSRect)firstRectForCharacterRange: (NSRange)theRange @@ -7069,7 +7099,7 @@ ns_create_font_panel_buttons (id target, SEL select, SEL cancel_action) if (NS_KEYLOG) NSLog (@"firstRectForCharRange request"); - if (WINDOWP (echo_area_window) && ! NILP (call0 (intern ("ns-in-echo-area")))) + if (WINDOWP (echo_area_window) && ns_in_echo_area ()) win = XWINDOW (echo_area_window); else win = XWINDOW (FRAME_SELECTED_WINDOW (emacsframe)); @@ -11012,6 +11042,7 @@ respectively. */); DEFSYM (Qcondensed, "condensed"); DEFSYM (Qreverse_italic, "reverse-italic"); DEFSYM (Qexpanded, "expanded"); + DEFSYM (Qns_in_echo_area, "ns-in-echo-area"); #ifdef NS_IMPL_COCOA Fprovide (Qcocoa, Qnil); diff --git a/src/pgtkfns.c b/src/pgtkfns.c index 9473e14f5cf..a32067af818 100644 --- a/src/pgtkfns.c +++ b/src/pgtkfns.c @@ -473,10 +473,19 @@ pgtk_set_tab_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) void pgtk_change_tab_bar_height (struct frame *f, int height) { - int unit = FRAME_LINE_HEIGHT (f); - int old_height = FRAME_TAB_BAR_HEIGHT (f); - int lines = (height + unit - 1) / unit; - Lisp_Object fullscreen = get_frame_param (f, Qfullscreen); + int unit, old_height, lines; + Lisp_Object fullscreen; + + unit = FRAME_LINE_HEIGHT (f); + old_height = FRAME_TAB_BAR_HEIGHT (f); + fullscreen = get_frame_param (f, Qfullscreen); + + /* This differs from the tool bar code in that the tab bar height is + not rounded up. Otherwise, if redisplay_tab_bar decides to grow + the tab bar by even 1 pixel, FRAME_TAB_BAR_LINES will be changed, + leading to the tab bar height being incorrectly set upon the next + call to x_set_font. (bug#59285) */ + lines = height / unit; /* Make sure we redisplay all windows in this frame. */ fset_redisplay (f); @@ -1112,13 +1121,6 @@ pgtk_default_font_parameter (struct frame *f, Lisp_Object parms) if (NILP (font)) error ("No suitable font was found"); } - else if (!NILP (font_param)) - { - /* Remember the explicit font parameter, so we can re-apply it after - we've applied the `default' face settings. */ - AUTO_FRAME_ARG (arg, Qfont_parameter, font_param); - gui_set_frame_parameters (f, arg); - } /* This call will make X resources override any system font setting. */ gui_default_parameter (f, parms, Qfont, font, "font", "Font", diff --git a/src/pgtkterm.c b/src/pgtkterm.c index 491ba338821..13f6c6c3c4d 100644 --- a/src/pgtkterm.c +++ b/src/pgtkterm.c @@ -511,16 +511,16 @@ pgtk_free_frame_resources (struct frame *f) if (FRAME_X_OUTPUT (f)->scrollbar_foreground_css_provider != NULL) { - GtkCssProvider *old = - FRAME_X_OUTPUT (f)->scrollbar_foreground_css_provider; + GtkCssProvider *old + = FRAME_X_OUTPUT (f)->scrollbar_foreground_css_provider; g_object_unref (old); FRAME_X_OUTPUT (f)->scrollbar_foreground_css_provider = NULL; } if (FRAME_X_OUTPUT (f)->scrollbar_background_css_provider != NULL) { - GtkCssProvider *old = - FRAME_X_OUTPUT (f)->scrollbar_background_css_provider; + GtkCssProvider *old + = FRAME_X_OUTPUT (f)->scrollbar_background_css_provider; g_object_unref (old); FRAME_X_OUTPUT (f)->scrollbar_background_css_provider = NULL; } @@ -714,40 +714,42 @@ pgtk_set_window_size (struct frame *f, bool change_gravity, void pgtk_iconify_frame (struct frame *f) -/* -------------------------------------------------------------------------- - External: Iconify window - -------------------------------------------------------------------------- */ { + GtkWindow *window; + /* Don't keep the highlight on an invisible frame. */ + if (FRAME_DISPLAY_INFO (f)->highlight_frame == f) - FRAME_DISPLAY_INFO (f)->highlight_frame = 0; + FRAME_DISPLAY_INFO (f)->highlight_frame = NULL; + + /* If the frame is already iconified, return. */ if (FRAME_ICONIFIED_P (f)) return; - block_input (); + /* Child frames on PGTK have no outer widgets. In that case, simply + refuse to iconify the frame. */ if (FRAME_GTK_OUTER_WIDGET (f)) { if (!FRAME_VISIBLE_P (f)) gtk_widget_show_all (FRAME_GTK_OUTER_WIDGET (f)); - gtk_window_iconify (GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f))); - SET_FRAME_VISIBLE (f, 0); - SET_FRAME_ICONIFIED (f, true); - unblock_input (); - return; - } + window = GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (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)) - pgtk_set_offset (f, f->left_pos, f->top_pos, 0); + gtk_window_iconify (window); - SET_FRAME_ICONIFIED (f, true); - SET_FRAME_VISIBLE (f, 0); + /* Don't make the frame iconified here. Doing so will cause it + to be skipped by redisplay, until GDK says it is deiconified + (see window_state_event for more details). However, if the + window server rejects the iconification request, GDK will + never tell Emacs about the iconification not happening, + leading to the frame not being redisplayed until the next + window state change. */ - unblock_input (); + /* SET_FRAME_VISIBLE (f, 0); + SET_FRAME_ICONIFIED (f, true); */ + } } static gboolean @@ -1331,8 +1333,8 @@ fill_background_by_face (struct frame *f, struct face *face, int x, int y, if (face->stipple != 0) { - cairo_pattern_t *mask = - FRAME_DISPLAY_INFO (f)->bitmaps[face->stipple - 1].pattern; + cairo_pattern_t *mask + = FRAME_DISPLAY_INFO (f)->bitmaps[face->stipple - 1].pattern; double r = ((face->foreground >> 16) & 0xff) / 255.0; double g = ((face->foreground >> 8) & 0xff) / 255.0; @@ -1604,8 +1606,8 @@ pgtk_draw_glyphless_glyph_string_foreground (struct glyph_string *s) /* 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; + 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, @@ -2956,8 +2958,8 @@ pgtk_draw_window_cursor (struct window *w, struct glyph_row *glyph_row, int x, if (w == XWINDOW (f->selected_window)) { - int frame_x = - WINDOW_TO_FRAME_PIXEL_X (w, x) + WINDOW_LEFT_FRINGE_WIDTH (w); + int frame_x = (WINDOW_TO_FRAME_PIXEL_X (w, x) + + WINDOW_LEFT_FRINGE_WIDTH (w)); int frame_y = WINDOW_TO_FRAME_PIXEL_Y (w, y); pgtk_im_set_cursor_location (f, frame_x, frame_y, w->phys_cursor_width, @@ -4516,16 +4518,29 @@ pgtk_free_pixmap (struct frame *f, Emacs_Pixmap pixmap) void pgtk_focus_frame (struct frame *f, bool noactivate) { - struct pgtk_display_info *dpyinfo = FRAME_DISPLAY_INFO (f); + struct pgtk_display_info *dpyinfo; + GtkWidget *widget; + GtkWindow *window; - GtkWidget *wid = FRAME_WIDGET (f); + dpyinfo = FRAME_DISPLAY_INFO (f); - if (dpyinfo->x_focus_frame != f && wid != NULL) + if (FRAME_GTK_OUTER_WIDGET (f) && !noactivate) { - block_input (); - gtk_widget_grab_focus (wid); - unblock_input (); + /* The user says it is okay to activate the frame. Call + gtk_window_present_with_time. If the timestamp specified + (actually a display serial on Wayland) is new enough, then + any Wayland compositor supporting gtk_surface1_present will + cause the frame to be activated. */ + + window = GTK_WINDOW (FRAME_GTK_OUTER_WIDGET (f)); + gtk_window_present_with_time (window, dpyinfo->last_user_time); + return; } + + widget = FRAME_WIDGET (f); + + if (widget) + gtk_widget_grab_focus (widget); } static void @@ -5142,13 +5157,15 @@ static gboolean key_press_event (GtkWidget *widget, GdkEvent *event, gpointer *user_data) { union buffered_input_event inev; - ptrdiff_t nbytes = 0; + ptrdiff_t nbytes; Mouse_HLInfo *hlinfo; struct frame *f; + struct pgtk_display_info *dpyinfo; f = pgtk_any_window_to_frame (gtk_widget_get_window (widget)); EVENT_INIT (inev.ie); hlinfo = MOUSE_HL_INFO (f); + nbytes = 0; /* If mouse-highlight is an integer, input clears out mouse highlighting. */ @@ -5179,6 +5196,12 @@ key_press_event (GtkWidget *widget, GdkEvent *event, gpointer *user_data) Lisp_Object c; guint state; + dpyinfo = FRAME_DISPLAY_INFO (f); + + /* Set the last user time for pgtk_focus_frame to work + correctly. */ + dpyinfo->last_user_time = event->key.time; + state = event->key.state; /* While super is pressed, the input method will always always @@ -5212,8 +5235,8 @@ key_press_event (GtkWidget *widget, GdkEvent *event, gpointer *user_data) /* Common for all keysym input events. */ XSETFRAME (inev.ie.frame_or_window, f); - inev.ie.modifiers = - pgtk_gtk_to_emacs_modifiers (FRAME_DISPLAY_INFO (f), modifiers); + inev.ie.modifiers + = pgtk_gtk_to_emacs_modifiers (FRAME_DISPLAY_INFO (f), modifiers); inev.ie.timestamp = event->key.time; /* First deal with keysyms which have defined @@ -5361,11 +5384,37 @@ done: return TRUE; } +static struct pgtk_display_info * +pgtk_display_info_for_display (GdkDisplay *dpy) +{ + struct pgtk_display_info *dpyinfo; + + for (dpyinfo = x_display_list; dpyinfo; dpyinfo = dpyinfo->next) + { + if (dpyinfo->display == dpy) + return dpyinfo; + } + + return NULL; +} + static gboolean key_release_event (GtkWidget *widget, GdkEvent *event, gpointer *user_data) { + GdkDisplay *display; + struct pgtk_display_info *dpyinfo; + + display = gtk_widget_get_display (widget); + dpyinfo = pgtk_display_info_for_display (display); + + if (dpyinfo) + /* This is needed on Wayland because of some brain dead + compositors. Without them, we would not have to keep track of + the serial of key release events. */ + dpyinfo->last_user_time = event->key.time; + return TRUE; } @@ -5420,9 +5469,7 @@ map_event (GtkWidget *widget, /* Check if fullscreen was specified before we where mapped the first time, i.e. from the command line. */ if (!FRAME_X_OUTPUT (f)->has_been_visible) - { - set_fullscreen_state (f); - } + set_fullscreen_state (f); if (!iconified) { @@ -5465,24 +5512,6 @@ window_state_event (GtkWidget *widget, inev.ie.kind = NO_EVENT; inev.ie.arg = Qnil; - if (f) - { - if (new_state & GDK_WINDOW_STATE_FOCUSED) - { - if (FRAME_ICONIFIED_P (f)) - { - /* Gnome shell does not iconify us when C-z is pressed. - It hides the frame. So if our state says we aren't - hidden anymore, treat it as deiconified. */ - SET_FRAME_VISIBLE (f, 1); - SET_FRAME_ICONIFIED (f, false); - FRAME_X_OUTPUT (f)->has_been_visible = true; - inev.ie.kind = DEICONIFY_EVENT; - XSETFRAME (inev.ie.frame_or_window, f); - } - } - } - if (new_state & GDK_WINDOW_STATE_FULLSCREEN) store_frame_param (f, Qfullscreen, Qfullboth); else if (new_state & GDK_WINDOW_STATE_MAXIMIZED) @@ -5500,14 +5529,37 @@ window_state_event (GtkWidget *widget, else store_frame_param (f, Qfullscreen, Qnil); + /* The Wayland protocol provides no way for the client to know + whether or not one of its toplevels has actually been + deiconified. It only provides a request for clients to iconify a + toplevel, without even the ability to determine whether or not + the iconification request was rejected by the display server. + + GDK computes the iconified state by sending a window state event + containing only GDK_WINDOW_STATE_ICONIFIED immediately after + gtk_window_iconify is called. That is error-prone if the request + to iconify the frame was rejected by the display server, but is + not the main problem here, as Wayland compositors only rarely + reject such requests. GDK also assumes that it can clear the + iconified state upon receiving the next toplevel configure event + from the display server. Unfortunately, such events can be sent + by Wayland compositors while the frame is iconified, and may also + not be sent upon deiconification. So, no matter what Emacs does, + the iconification state of a frame is likely to be wrong under + one situation or another. */ + if (new_state & GDK_WINDOW_STATE_ICONIFIED) - SET_FRAME_ICONIFIED (f, true); + { + SET_FRAME_ICONIFIED (f, true); + SET_FRAME_VISIBLE (f, false); + } else { FRAME_X_OUTPUT (f)->has_been_visible = true; inev.ie.kind = DEICONIFY_EVENT; XSETFRAME (inev.ie.frame_or_window, f); SET_FRAME_ICONIFIED (f, false); + SET_FRAME_VISIBLE (f, true); } if (new_state & GDK_WINDOW_STATE_STICKY) @@ -5899,9 +5951,10 @@ construct_mouse_click (struct input_event *result, result->kind = MOUSE_CLICK_EVENT; result->code = event->button - 1; result->timestamp = event->time; - result->modifiers = - (pgtk_gtk_to_emacs_modifiers (FRAME_DISPLAY_INFO (f), event->state) | - (event->type == GDK_BUTTON_RELEASE ? up_modifier : down_modifier)); + result->modifiers = (pgtk_gtk_to_emacs_modifiers (FRAME_DISPLAY_INFO (f), + event->state) + | (event->type == GDK_BUTTON_RELEASE + ? up_modifier : down_modifier)); XSETINT (result->x, event->x); XSETINT (result->y, event->y); @@ -5966,6 +6019,10 @@ button_event (GtkWidget *widget, GdkEvent *event, } } + /* Set the last user time, used to activate the frame in + pgtk_focus_frame. */ + dpyinfo->last_user_time = event->button.time; + if (f) { /* Is this in the tab-bar? */ @@ -5984,10 +6041,7 @@ button_event (GtkWidget *widget, GdkEvent *event, (f, x, y, event->type == GDK_BUTTON_PRESS, pgtk_gtk_to_emacs_modifiers (dpyinfo, event->button.state)); } - } - if (f) - { if (!(tab_bar_p && NILP (tab_bar_arg)) && !tool_bar_p) { if (ignore_next_mouse_click_timeout) @@ -6055,8 +6109,8 @@ scroll_event (GtkWidget *widget, GdkEvent *event, gpointer *user_data) inev.ie.kind = NO_EVENT; inev.ie.timestamp = event->scroll.time; - inev.ie.modifiers = - pgtk_gtk_to_emacs_modifiers (FRAME_DISPLAY_INFO (f), event->scroll.state); + inev.ie.modifiers + = pgtk_gtk_to_emacs_modifiers (FRAME_DISPLAY_INFO (f), event->scroll.state); XSETINT (inev.ie.x, event->scroll.x); XSETINT (inev.ie.y, event->scroll.y); XSETFRAME (inev.ie.frame_or_window, f); @@ -6594,6 +6648,44 @@ pgtk_selection_event (GtkWidget *widget, GdkEvent *event, return FALSE; } +/* Display a warning message if the PGTK port is being used under X; + that is not supported. */ + +static void +pgtk_display_x_warning (GdkDisplay *display) +{ + GtkWidget *dialog_widget, *label, *content_area; + GtkDialog *dialog; + GtkWindow *window; + GdkScreen *screen; + + /* Do this instead of GDK_IS_X11_DISPLAY because the GDK X header + pulls in Xlib, which conflicts with definitions in pgtkgui.h. */ + if (strcmp (G_OBJECT_TYPE_NAME (display), + "GdkX11Display")) + return; + + dialog_widget = gtk_dialog_new (); + dialog = GTK_DIALOG (dialog_widget); + window = GTK_WINDOW (dialog_widget); + screen = gdk_display_get_default_screen (display); + content_area = gtk_dialog_get_content_area (dialog); + + gtk_window_set_title (window, "Warning"); + gtk_window_set_screen (window, screen); + + label = gtk_label_new ("You are trying to run Emacs configured with" + " the \"pure-GTK\" interface under the X Window" + " System. That configuration is unsupported and" + " will lead to sporadic crashes during transfer of" + " large selection data. It will also lead to" + " various problems with keyboard input."); + gtk_label_set_line_wrap (GTK_LABEL (label), TRUE); + gtk_container_add (GTK_CONTAINER (content_area), label); + gtk_widget_show (label); + gtk_widget_show (dialog_widget); +} + /* Open a connection to X display DISPLAY_NAME, and return the structure that describes the open display. If we cannot contact the display, return null. */ @@ -6697,6 +6789,9 @@ pgtk_term_init (Lisp_Object display_name, char *resource_name) return 0; } + /* If the PGTK port is being used under X, complain very loudly, as + that isn't supported. */ + pgtk_display_x_warning (dpy); dpyinfo = xzalloc (sizeof *dpyinfo); pgtk_initialize_display_info (dpyinfo); @@ -6940,10 +7035,9 @@ pgtk_parse_color (struct frame *f, const char *color_name, color->red = rgba.red * 65535; color->green = rgba.green * 65535; color->blue = rgba.blue * 65535; - color->pixel = - (color->red >> 8) << 16 | - (color->green >> 8) << 8 | - (color->blue >> 8) << 0; + color->pixel = ((color->red >> 8) << 16 + | (color->green >> 8) << 8 + | (color->blue >> 8) << 0); return 1; } return 0; @@ -7072,10 +7166,9 @@ If set to a non-float value, there will be no wait at all. */); Vpgtk_wait_for_event_timeout = make_float (0.1); DEFVAR_LISP ("pgtk-keysym-table", Vpgtk_keysym_table, - doc: /* Hash table of character codes indexed by X keysym codes. */); - Vpgtk_keysym_table = - make_hash_table (hashtest_eql, 900, DEFAULT_REHASH_SIZE, - DEFAULT_REHASH_THRESHOLD, Qnil, false); + doc: /* Hash table of character codes indexed by X keysym codes. */); + Vpgtk_keysym_table = make_hash_table (hashtest_eql, 900, DEFAULT_REHASH_SIZE, + DEFAULT_REHASH_THRESHOLD, Qnil, false); window_being_scrolled = Qnil; staticpro (&window_being_scrolled); @@ -7113,13 +7206,13 @@ pgtk_begin_cr_clip (struct frame *f) if (!cr) { - cairo_surface_t *surface = - gdk_window_create_similar_surface (gtk_widget_get_window - (FRAME_GTK_WIDGET (f)), - CAIRO_CONTENT_COLOR_ALPHA, - FRAME_CR_SURFACE_DESIRED_WIDTH (f), - FRAME_CR_SURFACE_DESIRED_HEIGHT - (f)); + cairo_surface_t *surface + = gdk_window_create_similar_surface (gtk_widget_get_window + (FRAME_GTK_WIDGET (f)), + CAIRO_CONTENT_COLOR_ALPHA, + FRAME_CR_SURFACE_DESIRED_WIDTH (f), + FRAME_CR_SURFACE_DESIRED_HEIGHT + (f)); cr = FRAME_CR_CONTEXT (f) = cairo_create (surface); cairo_surface_destroy (surface); diff --git a/src/pgtkterm.h b/src/pgtkterm.h index fcc6c5310e9..b6bd10dcb41 100644 --- a/src/pgtkterm.h +++ b/src/pgtkterm.h @@ -262,6 +262,13 @@ struct pgtk_output unsigned long background_color; void *toolbar; + /* The "time" of the last user interaction on this display. Set + upon button and key press and release events. + + Under the GDK Wayland backend, this is actually an event + serial. */ + guint32 last_user_time; + /* Cursors */ Emacs_Cursor current_cursor; Emacs_Cursor text_cursor; @@ -357,8 +364,8 @@ struct pgtk_output /* The tool bar in this frame */ GtkWidget *toolbar_widget; /* True if tool bar is packed into the hbox widget (i.e. vertical). */ - bool_bf toolbar_in_hbox:1; - bool_bf toolbar_is_packed:1; + bool_bf toolbar_in_hbox : 1; + bool_bf toolbar_is_packed : 1; GtkTooltip *ttip_widget; GtkWidget *ttip_lbl; diff --git a/src/w32fns.c b/src/w32fns.c index 93b7f80f268..887e5a1f7b7 100644 --- a/src/w32fns.c +++ b/src/w32fns.c @@ -1717,10 +1717,19 @@ w32_set_tab_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) void w32_change_tab_bar_height (struct frame *f, int height) { - int unit = FRAME_LINE_HEIGHT (f); - int old_height = FRAME_TAB_BAR_HEIGHT (f); - int lines = (height + unit - 1) / unit; - Lisp_Object fullscreen = get_frame_param (f, Qfullscreen); + int unit, old_height, lines; + Lisp_Object fullscreen; + + unit = FRAME_LINE_HEIGHT (f); + old_height = FRAME_TAB_BAR_HEIGHT (f); + fullscreen = get_frame_param (f, Qfullscreen); + + /* This differs from the tool bar code in that the tab bar height is + not rounded up. Otherwise, if redisplay_tab_bar decides to grow + the tab bar by even 1 pixel, FRAME_TAB_BAR_LINES will be changed, + leading to the tab bar height being incorrectly set upon the next + call to x_set_font. (bug#59285) */ + lines = height / unit; /* Make sure we redisplay all windows in this frame. */ fset_redisplay (f); @@ -5785,13 +5794,7 @@ w32_default_font_parameter (struct frame *f, Lisp_Object parms) if (NILP (font)) error ("No suitable font was found"); } - else if (!NILP (font_param)) - { - /* Remember the explicit font parameter, so we can re-apply it after - we've applied the `default' face settings. */ - gui_set_frame_parameters (f, Fcons (Fcons (Qfont_parameter, font_param), - Qnil)); - } + gui_default_parameter (f, parms, Qfont, font, "font", "Font", RES_TYPE_STRING); } @@ -8417,7 +8420,7 @@ a ShowWindow flag: current_dir = ENCODE_FILE (current_dir); /* Cannot use filename_to_utf16/ansi with DOCUMENT, since it could - be a URL that is not limited to MAX_PATH chararcters. */ + be a URL that is not limited to MAX_PATH characters. */ doclen = pMultiByteToWideChar (CP_UTF8, multiByteToWideCharFlags, SSDATA (document), -1, NULL, 0); doc_w = xmalloc (doclen * sizeof (wchar_t)); diff --git a/src/w32inevt.c b/src/w32inevt.c index 6a1d9afacf7..d13b0521c9a 100644 --- a/src/w32inevt.c +++ b/src/w32inevt.c @@ -648,7 +648,7 @@ handle_file_notifications (struct input_event *hold_quit) ns = NULL; /* Find out if there is a record available in the linked list of - notifications sets. If so, unlink te set from the linked list. + notifications sets. If so, unlink the set from the linked list. Use the critical section. */ enter_crit (); if (notifications_set_head->next != notifications_set_head) diff --git a/src/xdisp.c b/src/xdisp.c index 95da704a070..b5f013ea6a1 100644 --- a/src/xdisp.c +++ b/src/xdisp.c @@ -2330,7 +2330,7 @@ pixel_to_glyph_coords (struct frame *f, int pix_x, int pix_y, int *x, int *y, text, or we can't tell because W's current matrix is not up to date. */ -static struct glyph * +struct glyph * x_y_to_hpos_vpos (struct window *w, int x, int y, int *hpos, int *vpos, int *dx, int *dy, int *area) { @@ -3342,7 +3342,8 @@ init_iterator (struct it *it, struct window *w, { /* Mode lines, menu bar in terminal frames. */ it->first_visible_x = 0; - it->last_visible_x = body_width = WINDOW_PIXEL_WIDTH (w); + it->last_visible_x = + WINDOW_PIXEL_WIDTH (w) - WINDOW_RIGHT_DIVIDER_WIDTH (w); } else { @@ -3410,8 +3411,13 @@ init_iterator (struct it *it, struct window *w, face = FACE_FROM_ID_OR_NULL (it->f, remapped_base_face_id); if (face && face->box != FACE_NO_BOX) { + int box_thickness = face->box_vertical_line_width; it->face_box_p = true; it->start_of_box_run_p = true; + /* Make sure we will have enough horizontal space to add the + right box line at the end. */ + if (box_thickness > 0) + it->last_visible_x -= box_thickness; } } @@ -5324,6 +5330,8 @@ display_min_width (struct it *it, ptrdiff_t bufpos, /* Insert the stretch glyph. */ it->object = list3 (Qspace, QCwidth, w); produce_stretch_glyph (it); + if (it->area == TEXT_AREA) + it->current_x += it->pixel_width; it->min_width_property = Qnil; } } @@ -7036,17 +7044,11 @@ strings_with_newlines (ptrdiff_t startpos, ptrdiff_t endpos, struct window *w) str = Foverlay_get (overlay, Qbefore_string); if (STRINGP (str) && SCHARS (str) && memchr (SDATA (str), '\n', SBYTES (str))) - { - ITREE_FOREACH_ABORT (); - return true; - } + return true; str = Foverlay_get (overlay, Qafter_string); if (STRINGP (str) && SCHARS (str) && memchr (SDATA (str), '\n', SBYTES (str))) - { - ITREE_FOREACH_ABORT (); - return true; - } + return true; } /* Check for 'display' properties whose values include strings. */ @@ -26718,7 +26720,17 @@ display_mode_line (struct window *w, enum face_id face_id, Lisp_Object format) { struct glyph *last = (it.glyph_row->glyphs[TEXT_AREA] + it.glyph_row->used[TEXT_AREA] - 1); + int box_thickness = face->box_vertical_line_width; last->right_box_line_p = true; + /* Add back the space for the right box line we subtracted in + init_iterator, since the right_box_line_p flag will make the + glyph wider. We actually add only as much space as is + available for the last glyph of the modeline and whatever + space is left beyond it, since that glyph could be only + partially visible */ + if (box_thickness > 0) + last->pixel_width += max (0, (box_thickness + - (it.current_x - it.last_visible_x))); } return it.glyph_row->height; @@ -33564,8 +33576,14 @@ coords_in_mouse_face_p (struct window *w, int hpos, int vpos) bool cursor_in_mouse_face_p (struct window *w) { - int hpos = w->phys_cursor.hpos; int vpos = w->phys_cursor.vpos; + + /* If the cursor is outside the matrix glyph rows, it cannot be + within the mouse face. */ + if (!(0 <= vpos && vpos < w->current_matrix->nrows)) + return false; + + int hpos = w->phys_cursor.hpos; struct glyph_row *row = MATRIX_ROW (w->current_matrix, vpos); /* When the window is hscrolled, cursor hpos can legitimately be out diff --git a/src/xfaces.c b/src/xfaces.c index ed76db9adb7..df078227c8a 100644 --- a/src/xfaces.c +++ b/src/xfaces.c @@ -3809,8 +3809,12 @@ set_font_frame_param (Lisp_Object frame, Lisp_Object lface) ASET (lface, LFACE_FONT_INDEX, font); } f->default_face_done_p = false; - AUTO_FRAME_ARG (arg, Qfont, font); - Fmodify_frame_parameters (frame, arg); + AUTO_LIST2 (arg, AUTO_CONS_EXPR (Qfont, font), + /* Clear the `font-parameter' frame property, as the + font is now being specified by a face, not a + frame property. */ + AUTO_CONS_EXPR (Qfont_parameter, Qnil)); + gui_set_frame_parameters_1 (f, arg, true); } } @@ -4208,7 +4212,17 @@ Default face attributes override any local face attributes. */) { Lisp_Object name = newface->font->props[FONT_NAME_INDEX]; AUTO_FRAME_ARG (arg, Qfont, name); - Fmodify_frame_parameters (frame, arg); + +#ifdef HAVE_WINDOW_SYSTEM + if (FRAME_WINDOW_P (f)) + /* This is a window-system frame. Prevent changes of + the `font' parameter here from messing with the + `font-parameter' frame property, as the frame + parameter is not being changed by the user. */ + gui_set_frame_parameters_1 (f, arg, true); + else +#endif + Fmodify_frame_parameters (frame, arg); } if (STRINGP (gvec[LFACE_FOREGROUND_INDEX])) diff --git a/src/xfns.c b/src/xfns.c index 3ff7a8c2865..95092ce05f4 100644 --- a/src/xfns.c +++ b/src/xfns.c @@ -1362,13 +1362,21 @@ x_set_mouse_color (struct frame *f, Lisp_Object arg, Lisp_Object oldval) char *xmessage = alloca (1 + message_length); memcpy (xmessage, cursor_data.error_string, message_length); - x_uncatch_errors (); + x_uncatch_errors_after_check (); + + /* XFreeCursor can generate BadCursor errors, because + XCreateFontCursor is not a request that waits for a reply, + and as such can return IDs that will not actually be used by + the server. */ + x_ignore_errors_for_next_request (FRAME_DISPLAY_INFO (f)); /* Free any successfully created cursors. */ for (i = 0; i < mouse_cursor_max; i++) if (cursor_data.cursor[i] != 0) XFreeCursor (dpy, cursor_data.cursor[i]); + x_stop_ignoring_errors (FRAME_DISPLAY_INFO (f)); + /* This should only be able to fail if the server's serial number tracking is broken. */ if (cursor_data.error_cursor >= 0) @@ -1750,10 +1758,19 @@ x_set_tab_bar_lines (struct frame *f, Lisp_Object value, Lisp_Object oldval) void x_change_tab_bar_height (struct frame *f, int height) { - int unit = FRAME_LINE_HEIGHT (f); - int old_height = FRAME_TAB_BAR_HEIGHT (f); - int lines = (height + unit - 1) / unit; - Lisp_Object fullscreen = get_frame_param (f, Qfullscreen); + int unit, old_height, lines; + Lisp_Object fullscreen; + + unit = FRAME_LINE_HEIGHT (f); + old_height = FRAME_TAB_BAR_HEIGHT (f); + fullscreen = get_frame_param (f, Qfullscreen); + + /* This differs from the tool bar code in that the tab bar height is + not rounded up. Otherwise, if redisplay_tab_bar decides to grow + the tab bar by even 1 pixel, FRAME_TAB_BAR_LINES will be changed, + leading to the tab bar height being incorrectly set upon the next + call to x_set_font. (bug#59285) */ + lines = height / unit; /* Make sure we redisplay all windows in this frame. */ fset_redisplay (f); @@ -4506,9 +4523,11 @@ x_default_font_parameter (struct frame *f, Lisp_Object parms) } if (NILP (font)) - font = !NILP (font_param) ? font_param - : gui_display_get_arg (dpyinfo, parms, Qfont, "font", "Font", - RES_TYPE_STRING); + font = (!NILP (font_param) + ? font_param + : gui_display_get_arg (dpyinfo, parms, + Qfont, "font", "Font", + RES_TYPE_STRING)); if (! FONTP (font) && ! STRINGP (font)) { @@ -4540,13 +4559,6 @@ x_default_font_parameter (struct frame *f, Lisp_Object parms) if (NILP (font)) error ("No suitable font was found"); } - else if (!NILP (font_param)) - { - /* Remember the explicit font parameter, so we can re-apply it after - we've applied the `default' face settings. */ - AUTO_FRAME_ARG (arg, Qfont_parameter, font_param); - gui_set_frame_parameters (f, arg); - } /* This call will make X resources override any system font setting. */ gui_default_parameter (f, parms, Qfont, font, "font", "Font", RES_TYPE_STRING); diff --git a/src/xselect.c b/src/xselect.c index db5c7853e7f..a381fa23522 100644 --- a/src/xselect.c +++ b/src/xselect.c @@ -918,6 +918,13 @@ x_handle_selection_request (struct selection_input_event *event) } /* Save conversion results */ lisp_data_to_selection_data (dpyinfo, multprop, &cs); + + /* If cs.type is ATOM, change it to ATOM_PAIR. This is because + the parameters to a MULTIPLE are ATOM_PAIRs. */ + + if (cs.type == XA_ATOM) + cs.type = dpyinfo->Xatom_ATOM_PAIR; + XChangeProperty (dpyinfo->display, requestor, property, cs.type, cs.format, PropModeReplace, cs.data, cs.size); @@ -960,7 +967,7 @@ x_handle_selection_request (struct selection_input_event *event) x_reply_selection_request. If FOR_MULTIPLE, write out the data even if conversion fails, using conversion_fail_tag. - Return true iff successful. */ + Return true if successful. */ static bool x_convert_selection (Lisp_Object selection_symbol, diff --git a/src/xsettings.c b/src/xsettings.c index 15e7ff54995..00b67539d41 100644 --- a/src/xsettings.c +++ b/src/xsettings.c @@ -56,6 +56,7 @@ typedef unsigned int CARD32; #ifdef USE_CAIRO #include <fontconfig/fontconfig.h> +#include "ftfont.h" #elif defined HAVE_XFT #include <X11/Xft/Xft.h> #endif @@ -765,7 +766,7 @@ parse_settings (unsigned char *prop, #ifndef HAVE_PGTK /* Read settings from the XSettings property window on display for DPYINFO. Store settings read in SETTINGS. - Return true iff successful. */ + Return true if successful. */ static bool read_settings (Display_Info *dpyinfo, struct xsettings *settings) @@ -826,6 +827,7 @@ apply_xft_settings (Display_Info *dpyinfo, #else FcConfigSubstitute (NULL, pat, FcMatchPattern); options = cairo_font_options_create (); + ftcrfont_get_default_font_options (dpyinfo, options); cairo_ft_font_options_substitute (options, pat); cairo_font_options_destroy (options); FcDefaultSubstitute (pat); @@ -884,6 +886,14 @@ apply_xft_settings (Display_Info *dpyinfo, } #endif +#ifdef USE_CAIRO + /* When Cairo is being used, set oldsettings.dpi to dpyinfo->resx. + This is a gross hack, but seeing as Cairo fails to report + anything reasonable, just use it to avoid config-changed events + being sent at startup. */ + oldsettings.dpi = dpyinfo->resx; +#endif + if ((settings->seen & SEEN_DPI) != 0 && settings->dpi > 0 /* The following conjunct avoids setting `changed' to true when diff --git a/src/xterm.c b/src/xterm.c index 861cf5da549..af652a0d856 100644 --- a/src/xterm.c +++ b/src/xterm.c @@ -912,11 +912,6 @@ struct x_selection_request_event struct x_selection_request_event *pending_selection_requests; -/* Compare two request serials A and B with OP, handling - wraparound. */ -#define X_COMPARE_SERIALS(a, op ,b) \ - (((long) (a) - (long) (b)) op 0) - struct x_atom_ref { /* Atom name. */ @@ -1139,6 +1134,7 @@ static void x_clean_failable_requests (struct x_display_info *); static struct frame *x_tooltip_window_to_frame (struct x_display_info *, Window, bool *); static Window x_get_window_below (Display *, Window, int, int, int *, int *); +static void x_set_input_focus (struct x_display_info *, Window, Time); #ifndef USE_TOOLKIT_SCROLL_BARS static void x_scroll_bar_redraw (struct scroll_bar *); @@ -5327,6 +5323,46 @@ struct xi_known_valuator struct xi_known_valuator *next; }; +/* Populate the scroll valuator at INDEX in DEVICE with the scroll + valuator information provided in INFO. + + The information consists of: + + - whether or not the valuator is horizontal. + + - whether or not the valuator's value is currently unknown, + until the next XI_Motion event is received or the valuator's + value is restored by the caller upon encountering valuator + class data. + + - what the current value of the valuator is. This is set to + DBL_MIN for debugging purposes, but can be any value, as + invalid_p is currently true. + + - the increment, which defines the amount of movement equal to a + single unit of scrolling. For example, if the increment is + 2.0, then a WHEEL_DOWN or WHEEL_UP event will be sent every + time the valuator value changes by 2.0, unless + mwheel-coalesce-scroll-events is nil. + + - the number used in XI_Motion events and elsewhere to identify + the valuator. */ + +static void +xi_populate_scroll_valuator (struct xi_device_t *device, + int index, XIScrollClassInfo *info) +{ + struct xi_scroll_valuator_t *valuator; + + valuator = &device->valuators[index]; + valuator->horizontal + = (info->scroll_type == XIScrollTypeHorizontal); + valuator->invalid_p = true; + valuator->emacs_value = DBL_MIN; + valuator->increment = info->increment; + valuator->number = info->number; +} + #endif static void @@ -5335,11 +5371,10 @@ xi_populate_device_from_info (struct x_display_info *dpyinfo, XIDeviceInfo *device) { #ifdef HAVE_XINPUT2_1 - struct xi_scroll_valuator_t *valuator; struct xi_known_valuator *values, *tem; int actual_valuator_count, c; XIScrollClassInfo *info; - XIValuatorClassInfo *val_info; + XIValuatorClassInfo *valuator_info; #endif #ifdef HAVE_XINPUT2_2 XITouchClassInfo *touch_info; @@ -5436,26 +5471,30 @@ xi_populate_device_from_info (struct x_display_info *dpyinfo, case XIScrollClass: { info = (XIScrollClassInfo *) device->classes[c]; - - valuator = &xi_device->valuators[actual_valuator_count++]; - valuator->horizontal - = (info->scroll_type == XIScrollTypeHorizontal); - valuator->invalid_p = true; - valuator->emacs_value = DBL_MIN; - valuator->increment = info->increment; - valuator->number = info->number; - + xi_populate_scroll_valuator (xi_device, actual_valuator_count++, + info); break; } case XIValuatorClass: { - val_info = (XIValuatorClassInfo *) device->classes[c]; + valuator_info = (XIValuatorClassInfo *) device->classes[c]; tem = SAFE_ALLOCA (sizeof *tem); + /* Avoid restoring bogus values if some driver + accidentally specifies relative values in scroll + valuator classes how the input extension spec says they + should be, but allow restoring values when a value is + set, which is how the input extension actually + behaves. */ + + if (valuator_info->value == 0.0 + && valuator_info->mode != XIModeAbsolute) + continue; + tem->next = values; - tem->number = val_info->number; - tem->current_value = val_info->value; + tem->number = valuator_info->number; + tem->current_value = valuator_info->value; values = tem; break; @@ -13157,13 +13196,9 @@ xi_handle_new_classes (struct x_display_info *dpyinfo, struct xi_device_t *devic case XIScrollClass: scroll = (XIScrollClassInfo *) classes[i]; - valuator = &device->valuators[device->scroll_valuator_count++]; - valuator->horizontal = (scroll->scroll_type - == XIScrollTypeHorizontal); - valuator->invalid_p = true; - valuator->emacs_value = 0; - valuator->increment = scroll->increment; - valuator->number = scroll->number; + xi_populate_scroll_valuator (device, + device->scroll_valuator_count++, + scroll); break; #ifdef HAVE_XINPUT2_2 @@ -13182,22 +13217,32 @@ xi_handle_new_classes (struct x_display_info *dpyinfo, struct xi_device_t *devic for (i = 0; i < num_classes; ++i) { - switch (classes[i]->type) - { - case XIValuatorClass: - valuator_info = (XIValuatorClassInfo *) classes[i]; + if (classes[i]->type != XIValuatorClass) + continue; - valuator = xi_get_scroll_valuator (device, - valuator_info->number); - if (valuator) - { - valuator->invalid_p = false; - valuator->current_value = valuator_info->value; - valuator->emacs_value = 0; - } + valuator_info = (XIValuatorClassInfo *) classes[i]; - break; - } + /* Avoid restoring bogus values if some driver accidentally + specifies relative values in scroll valuator classes how the + input extension spec says they should be, but allow restoring + values when a value is set, which is how the input extension + actually behaves. */ + + if (valuator_info->value == 0.0 + && valuator_info->mode != XIModeAbsolute) + continue; + + valuator = xi_get_scroll_valuator (device, + valuator_info->number); + + if (!valuator) + continue; + + valuator->invalid_p = false; + valuator->current_value = valuator_info->value; + valuator->emacs_value = 0; + + break; } } @@ -13522,7 +13567,7 @@ x_find_modifier_meanings (struct x_display_info *dpyinfo) #ifdef HAVE_XKB int i; int found_meta_p = false; - uint vmodmask; + unsigned int vmodmask; #endif dpyinfo->meta_mod_mask = 0; @@ -14218,6 +14263,136 @@ x_get_window_below (Display *dpy, Window window, return value; } +/* Like XTmouse_position, but much faster. */ + +static void +x_fast_mouse_position (struct frame **fp, int insist, Lisp_Object *bar_window, + enum scroll_bar_part *part, Lisp_Object *x, Lisp_Object *y, + Time *timestamp) +{ + int root_x, root_y, win_x, win_y; + unsigned int mask; + Window dummy; + struct scroll_bar *bar; + struct x_display_info *dpyinfo; + Lisp_Object tail, frame; + struct frame *f1; + + dpyinfo = FRAME_DISPLAY_INFO (*fp); + + if (dpyinfo->last_mouse_scroll_bar && !insist) + { + bar = dpyinfo->last_mouse_scroll_bar; + + if (bar->horizontal) + x_horizontal_scroll_bar_report_motion (fp, bar_window, part, + x, y, timestamp); + else + x_scroll_bar_report_motion (fp, bar_window, part, + x, y, timestamp); + + return; + } + + if (!EQ (Vx_use_fast_mouse_position, Qreally_fast)) + { + /* This means that Emacs should select a frame and report the + mouse position relative to it. The approach used here avoids + making multiple roundtrips to the X server querying for the + window beneath the pointer, and was borrowed from + haiku_mouse_position in haikuterm.c. */ + + FOR_EACH_FRAME (tail, frame) + { + if (FRAME_X_P (XFRAME (frame)) + && (FRAME_DISPLAY_INFO (XFRAME (frame)) + == dpyinfo)) + XFRAME (frame)->mouse_moved = false; + } + + if (gui_mouse_grabbed (dpyinfo) + && !EQ (track_mouse, Qdropping) + && !EQ (track_mouse, Qdrag_source)) + /* Pick the last mouse frame if dropping. */ + f1 = dpyinfo->last_mouse_frame; + else + /* Otherwise, pick the last mouse motion frame. */ + f1 = dpyinfo->last_mouse_motion_frame; + + if (!f1 && (FRAME_X_P (SELECTED_FRAME ()) + && (FRAME_DISPLAY_INFO (SELECTED_FRAME ()) + == dpyinfo))) + f1 = SELECTED_FRAME (); + + if (!f1 || (!FRAME_X_P (f1) && (insist > 0))) + FOR_EACH_FRAME (tail, frame) + if (FRAME_X_P (XFRAME (frame)) + && (FRAME_DISPLAY_INFO (XFRAME (frame)) + == dpyinfo) + && !FRAME_TOOLTIP_P (XFRAME (frame))) + f1 = XFRAME (frame); + + if (f1 && FRAME_TOOLTIP_P (f1)) + f1 = NULL; + + if (f1 && FRAME_X_P (f1) && FRAME_X_WINDOW (f1)) + { + if (!x_query_pointer (dpyinfo->display, FRAME_X_WINDOW (f1), + &dummy, &dummy, &root_x, &root_y, + &win_x, &win_y, &mask)) + /* The pointer is out of the screen. */ + return; + + remember_mouse_glyph (f1, win_x, win_y, + &dpyinfo->last_mouse_glyph); + dpyinfo->last_mouse_glyph_frame = f1; + + *bar_window = Qnil; + *part = scroll_bar_nowhere; + + /* If track-mouse is `drag-source' and the mouse pointer is + certain to not be actually under the chosen frame, return + NULL in FP. */ + if (EQ (track_mouse, Qdrag_source) + && (win_x < 0 || win_y < 0 + || win_x >= FRAME_PIXEL_WIDTH (f1) + || win_y >= FRAME_PIXEL_HEIGHT (f1))) + *fp = NULL; + else + *fp = f1; + + *timestamp = dpyinfo->last_mouse_movement_time; + XSETINT (*x, win_x); + XSETINT (*y, win_y); + } + } + else + { + /* This means Emacs should only report the coordinates of the + last mouse motion. */ + + if (dpyinfo->last_mouse_motion_frame) + { + *fp = dpyinfo->last_mouse_motion_frame; + *timestamp = dpyinfo->last_mouse_movement_time; + *x = make_fixnum (dpyinfo->last_mouse_motion_x); + *y = make_fixnum (dpyinfo->last_mouse_motion_y); + *bar_window = Qnil; + *part = scroll_bar_nowhere; + + FOR_EACH_FRAME (tail, frame) + { + if (FRAME_X_P (XFRAME (frame)) + && (FRAME_DISPLAY_INFO (XFRAME (frame)) + == dpyinfo)) + XFRAME (frame)->mouse_moved = false; + } + + dpyinfo->last_mouse_motion_frame->mouse_moved = false; + } + } +} + /* Return the current position of the mouse. *FP should be a frame which indicates which display to ask about. @@ -14244,9 +14419,27 @@ XTmouse_position (struct frame **fp, int insist, Lisp_Object *bar_window, Time *timestamp) { struct frame *f1, *maybe_tooltip; - struct x_display_info *dpyinfo = FRAME_DISPLAY_INFO (*fp); + struct x_display_info *dpyinfo; bool unrelated_tooltip; + dpyinfo = FRAME_DISPLAY_INFO (*fp); + + if (!NILP (Vx_use_fast_mouse_position)) + { + /* The user says that Emacs is running over the network, and a + fast approximation of `mouse-position' should be used. + + Depending on what the value of `x-use-fast-mouse-position' + is, do one of two things: only perform the XQueryPointer to + obtain the coordinates from the last mouse frame, or only + return the last mouse motion frame and the + last_mouse_motion_x and Y. */ + + x_fast_mouse_position (fp, insist, bar_window, part, x, + y, timestamp); + return; + } + block_input (); if (dpyinfo->last_mouse_scroll_bar && insist == 0) @@ -14368,7 +14561,7 @@ XTmouse_position (struct frame **fp, int insist, Lisp_Object *bar_window, break; } #ifdef USE_GTK - /* We don't wan't to know the innermost window. We + /* We don't want to know the innermost window. We want the edit window. For non-Gtk+ the innermost window is the edit window. For Gtk+ it might not be. It might be the tool bar for example. */ @@ -14399,7 +14592,7 @@ XTmouse_position (struct frame **fp, int insist, Lisp_Object *bar_window, never use them in that case.) */ #ifdef USE_GTK - /* We don't wan't to know the innermost window. We + /* We don't want to know the innermost window. We want the edit window. */ f1 = x_window_to_frame (dpyinfo, win); #else @@ -18759,7 +18952,7 @@ handle_one_xevent (struct x_display_info *dpyinfo, /* If drag-and-drop or another modal dialog/menu is in progress, handle SelectionRequest events immediately, by - pushing it onto the selecction queue. */ + pushing it onto the selection queue. */ if (x_use_pending_selection_requests) { @@ -21119,8 +21312,11 @@ handle_one_xevent (struct x_display_info *dpyinfo, if (FRAME_PARENT_FRAME (f) || (hf && frame_ancestor_p (f, hf))) { + x_ignore_errors_for_next_request (dpyinfo); XSetInputFocus (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f), RevertToParent, event->xbutton.time); + x_stop_ignoring_errors (dpyinfo); + if (FRAME_PARENT_FRAME (f)) XRaiseWindow (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f)); } @@ -22822,9 +23018,13 @@ handle_one_xevent (struct x_display_info *dpyinfo, } #else /* Non-no toolkit builds without GTK 3 use core - events to handle focus. */ + events to handle focus. Errors are still + caught here in case the window is not + viewable. */ + x_ignore_errors_for_next_request (dpyinfo); XSetInputFocus (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f), RevertToParent, xev->time); + x_stop_ignoring_errors (dpyinfo); #endif if (FRAME_PARENT_FRAME (f)) XRaiseWindow (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f)); @@ -23079,7 +23279,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; + unsigned int old_state; struct xi_device_t *device, *source; coding = Qlatin_1; @@ -23225,8 +23425,9 @@ handle_one_xevent (struct x_display_info *dpyinfo, #ifdef HAVE_XKB if (dpyinfo->xkb_desc) { - uint xkb_state = state; - xkb_state &= ~(1 << 13 | 1 << 14); + unsigned int xkb_state; + + xkb_state = state & ~(1 << 13 | 1 << 14); xkb_state |= xev->group.effective << 13; if (!XkbTranslateKeyCode (dpyinfo->xkb_desc, keycode, @@ -25062,6 +25263,48 @@ static struct x_error_message_stack *x_error_message; /* The amount of items (depth) in that stack. */ int x_error_message_count; +/* Compare various request serials while handling wraparound. Treat a + difference of more than X_ULONG_MAX / 2 as wraparound. + + Note that these functions truncate serials to 32 bits before + comparison. */ + +static bool +x_is_serial_more_than (unsigned int a, unsigned int b) +{ + if (a > b) + return true; + + return (b - a > X_ULONG_MAX / 2); +} + +static bool +x_is_serial_more_than_or_equal_to (unsigned int a, unsigned int b) +{ + if (a >= b) + return true; + + return (b - a > X_ULONG_MAX / 2); +} + +static bool +x_is_serial_less_than (unsigned int a, unsigned int b) +{ + if (a < b) + return true; + + return (a - b > X_ULONG_MAX / 2); +} + +static bool +x_is_serial_less_than_or_equal_to (unsigned int a, unsigned int b) +{ + if (a <= b) + return true; + + return (a - b > X_ULONG_MAX / 2); +} + static struct x_error_message_stack * x_find_error_handler (Display *dpy, XErrorEvent *event) { @@ -25071,8 +25314,8 @@ x_find_error_handler (Display *dpy, XErrorEvent *event) while (stack) { - if (X_COMPARE_SERIALS (event->serial, >=, - stack->first_request) + if (x_is_serial_more_than_or_equal_to (event->serial, + stack->first_request) && dpy == stack->dpy) return stack; @@ -25175,11 +25418,11 @@ x_request_can_fail (struct x_display_info *dpyinfo, failable_requests < dpyinfo->next_failable_request; failable_requests++) { - if (X_COMPARE_SERIALS (request, >=, - failable_requests->start) + if (x_is_serial_more_than_or_equal_to (request, + failable_requests->start) && (!failable_requests->end - || X_COMPARE_SERIALS (request, <=, - failable_requests->end))) + || x_is_serial_less_than_or_equal_to (request, + failable_requests->end))) return failable_requests; } @@ -25197,11 +25440,11 @@ x_clean_failable_requests (struct x_display_info *dpyinfo) for (first = dpyinfo->failable_requests; first < last; first++) { - if (X_COMPARE_SERIALS (first->start, >, - LastKnownRequestProcessed (dpyinfo->display)) + if (x_is_serial_more_than (first->start, + LastKnownRequestProcessed (dpyinfo->display)) || !first->end - || X_COMPARE_SERIALS (first->end, >, - LastKnownRequestProcessed (dpyinfo->display))) + || x_is_serial_more_than (first->end, + LastKnownRequestProcessed (dpyinfo->display))) break; } @@ -25280,8 +25523,7 @@ x_stop_ignoring_errors (struct x_display_info *dpyinfo) /* Abort if no request was made since `x_ignore_errors_for_next_request'. */ - if (X_COMPARE_SERIALS (range->end, <, - range->start)) + if (x_is_serial_less_than (range->end, range->start)) emacs_abort (); #ifdef HAVE_GTK3 @@ -27470,11 +27712,10 @@ x_ewmh_activate_frame (struct frame *f) { time = x_get_server_time (f); - x_ignore_errors_for_next_request (dpyinfo); - XSetInputFocus (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f), - RevertToParent, time); + x_set_input_focus (FRAME_DISPLAY_INFO (f), + FRAME_OUTER_WINDOW (f), + time); XRaiseWindow (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f)); - x_stop_ignoring_errors (dpyinfo); return; } @@ -27500,6 +27741,76 @@ x_get_focus_frame (struct frame *f) return lisp_focus; } +/* Return the toplevel parent of F, if it is a child frame. + Otherwise, return NULL. */ + +static struct frame * +x_get_toplevel_parent (struct frame *f) +{ + struct frame *parent; + + if (!FRAME_PARENT_FRAME (f)) + return NULL; + + parent = FRAME_PARENT_FRAME (f); + + while (FRAME_PARENT_FRAME (parent)) + parent = FRAME_PARENT_FRAME (parent); + + return parent; +} + +static void +x_set_input_focus (struct x_display_info *dpyinfo, Window window, + Time time) +{ +#ifdef HAVE_XINPUT2 + struct xi_device_t *device; +#endif + + /* Do the equivalent of XSetInputFocus with the specified window and + time, but use the attachment to the device that Emacs has + designated the client pointer on X Input Extension builds. + Asynchronously trap errors around the generated XI_SetFocus or + SetInputFocus request, in case the device has been destroyed or + the window obscured. + + The revert_to will be set to RevertToParent for generated + SetInputFocus requests. */ + +#ifdef HAVE_XINPUT2 + if (dpyinfo->supports_xi2 + && dpyinfo->client_pointer_device != -1) + { + device = xi_device_from_id (dpyinfo, dpyinfo->client_pointer_device); + + /* The device is a master pointer. Use its attachment, which + should be the master keyboard. */ + + if (device) + { + eassert (device->use == XIMasterPointer); + + x_ignore_errors_for_next_request (dpyinfo); + XISetFocus (dpyinfo->display, device->attachment, + /* Note that the input extension + only supports RevertToParent-type + behavior. */ + window, time); + x_stop_ignoring_errors (dpyinfo); + + return; + } + } +#endif + + /* Otherwise, use the pointer device that the X server says is the + client pointer. */ + x_ignore_errors_for_next_request (dpyinfo); + XSetInputFocus (dpyinfo->display, window, RevertToParent, time); + x_stop_ignoring_errors (dpyinfo); +} + /* In certain situations, when the window manager follows a click-to-focus policy, there seems to be no way around calling XSetInputFocus to give another frame the input focus. @@ -27525,6 +27836,18 @@ x_focus_frame (struct frame *f, bool noactivate) else { if (!noactivate + /* If F is override-redirect, use SetInputFocus instead. + Override-redirect frames are not subject to window + management. */ + && !FRAME_OVERRIDE_REDIRECT (f) + /* If F is a child frame, use SetInputFocus instead. This + may not work if its parent is not activated. */ + && !FRAME_PARENT_FRAME (f) + /* If the focus is being transferred from a child frame to + its toplevel parent, also use SetInputFocus. */ + && (!dpyinfo->x_focus_frame + || (x_get_toplevel_parent (dpyinfo->x_focus_frame) + != f)) && x_wm_supports (f, dpyinfo->Xatom_net_active_window)) { /* When window manager activation is possible, use it @@ -27536,8 +27859,6 @@ x_focus_frame (struct frame *f, bool noactivate) return; } - /* Ignore any BadMatch error this request might result in. */ - x_ignore_errors_for_next_request (dpyinfo); if (NILP (Vx_no_window_manager)) { /* Use the last user time. It is invalid to use CurrentTime @@ -27555,15 +27876,19 @@ x_focus_frame (struct frame *f, bool noactivate) && !dpyinfo->x_focus_frame) time = x_get_server_time (f); - XSetInputFocus (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f), - RevertToParent, time); + /* Ignore any BadMatch error this request might result in. + A BadMatch error can occur if the window was obscured + after the time of the last user interaction without + changing the last-focus-change-time. */ + x_set_input_focus (FRAME_DISPLAY_INFO (f), FRAME_OUTER_WINDOW (f), + time); } else - XSetInputFocus (FRAME_X_DISPLAY (f), FRAME_OUTER_WINDOW (f), - /* But when no window manager is in use, we - don't care. */ - RevertToParent, CurrentTime); - x_stop_ignoring_errors (dpyinfo); + x_set_input_focus (FRAME_DISPLAY_INFO (f), FRAME_OUTER_WINDOW (f), + /* But when no window manager is in use, + respecting the ICCCM doesn't really + matter. */ + CurrentTime); } } @@ -29035,10 +29360,9 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) #endif int i; +#if defined HAVE_XFIXES && defined USE_XCB USE_SAFE_ALLOCA; - - /* Avoid warnings when SAFE_ALLOCA is not actually used. */ - ((void) SAFE_ALLOCA (0)); +#endif block_input (); @@ -29192,7 +29516,9 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) unblock_input (); +#if defined HAVE_XFIXES && defined USE_XCB SAFE_FREE (); +#endif return 0; } @@ -29212,7 +29538,9 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) unblock_input (); +#if defined HAVE_XFIXES && defined USE_XCB SAFE_FREE (); +#endif return 0; } #endif @@ -29920,7 +30248,7 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) XrmPutLineResource (&xrdb, "Emacs.dialog.*.font: 9x15"); /* Do not destroy the font struct returned above with XFreeFont; - that also destroys the font, leading to to X protocol errors at + that also destroys the font, leading to X protocol errors at XtCloseDisplay. Just free the font info structure. (Bug#18403) */ XFreeFontInfo (NULL, query_result, 1); @@ -30097,7 +30425,9 @@ x_term_init (Lisp_Object display_name, char *xrm_option, char *resource_name) unblock_input (); +#if defined HAVE_XFIXES && defined USE_XCB SAFE_FREE (); +#endif return dpyinfo; } @@ -30977,6 +31307,7 @@ With MS Windows, Haiku windowing or Nextstep, the value is t. */); DEFSYM (Qimitate_pager, "imitate-pager"); DEFSYM (Qnewer_time, "newer-time"); DEFSYM (Qraise_and_focus, "raise-and-focus"); + DEFSYM (Qreally_fast, "really-fast"); DEFVAR_LISP ("x-ctrl-keysym", Vx_ctrl_keysym, doc: /* Which keys Emacs uses for the ctrl modifier. @@ -31256,4 +31587,19 @@ not bypass window manager focus stealing prevention): - The symbol `raise-and-focus', which means to raise the window and focus it manually. */); Vx_allow_focus_stealing = Qnewer_time; + + DEFVAR_LISP ("x-use-fast-mouse-position", Vx_use_fast_mouse_position, + doc: /* How to make `mouse-position' faster. + +`mouse-position' and `mouse-pixel-position' default to querying the X +server for the window under the mouse pointer. This results in +accurate results, but is also very slow when the X connection has +moderate to high latency. Setting this variable to a non-nil value +makes Emacs query only for the position of the pointer, which is +usually faster. Doing so improves the performance of dragging to +select text over slow X connections. + +If that is still too slow, setting this variable to the symbol +`really-fast' will make Emacs return only cached values. */); + Vx_use_fast_mouse_position = Qnil; } diff --git a/src/xterm.h b/src/xterm.h index 1124dcceb4a..c36920081d3 100644 --- a/src/xterm.h +++ b/src/xterm.h @@ -580,7 +580,9 @@ struct x_display_info Time last_user_time; /* Position where the mouse was last time we reported a motion. - This is a position on last_mouse_motion_frame. */ + This is a position on last_mouse_motion_frame. It is used in + some situations to report the mouse position as well: see + XTmouse_position. */ int last_mouse_motion_x; int last_mouse_motion_y; @@ -1605,22 +1607,15 @@ SELECTION_EVENT_DISPLAY (struct selection_input_event *ev) extern void x_free_gcs (struct frame *); extern void x_relative_mouse_position (struct frame *, int *, int *); -extern void x_real_pos_and_offsets (struct frame *f, - int *left_offset_x, - int *right_offset_x, - int *top_offset_y, - int *bottom_offset_y, - int *x_pixels_diff, - int *y_pixels_diff, - int *xptr, - int *yptr, - int *outer_border); -extern void x_default_font_parameter (struct frame* f, Lisp_Object parms); +extern void x_real_pos_and_offsets (struct frame *, int *, int *, int *, + int *, int *, int *, int *, int *, + int *); +extern void x_default_font_parameter (struct frame *, Lisp_Object); /* From xrdb.c. */ -XrmDatabase x_load_resources (Display *, const char *, const char *, - const char *); +extern XrmDatabase x_load_resources (Display *, const char *, const char *, + const char *); extern const char *x_get_string_resource (void *, const char *, const char *); /* Defined in xterm.c */ diff --git a/test/lisp/auth-source-pass-tests.el b/test/lisp/auth-source-pass-tests.el index f5147a7ce07..6e6671efca5 100644 --- a/test/lisp/auth-source-pass-tests.el +++ b/test/lisp/auth-source-pass-tests.el @@ -25,7 +25,7 @@ ;;; Code: -(require 'ert) +(require 'ert-x) (require 'auth-source-pass) @@ -59,7 +59,7 @@ "Contains a list of all messages passed to `auth-source-do-debug'.") (defun auth-source-pass--have-message-matching (regexp) - "Return non-nil iff at least one `auth-source-do-debug' match REGEXP." + "Return non-nil if at least one `auth-source-do-debug' match REGEXP." (seq-find (lambda (message) (string-match regexp message)) auth-source-pass--debug-log)) @@ -109,7 +109,7 @@ ENTRY, HOSTNAME, USER and PORT are the same as in (put 'auth-source-pass-match-entry-p 'ert-explainer #'auth-source-pass--explain-match-entry-p) (defun auth-source-pass--includes-sorted-entries (entries hostname &optional user port) - "Return non-nil iff ENTRIES matching the parameters are found in store. + "Return non-nil if ENTRIES matching the parameters are found in store. ENTRIES should be sorted from most specific to least specific. HOSTNAME, USER and PORT are passed unchanged to @@ -157,7 +157,7 @@ result is ordered the same way as the suffixes." (auth-source-pass--generate-entry-suffixes hostname user port)))) (defun auth-source-pass-match-entry-p (entry hostname &optional user port) - "Return non-nil iff an ENTRY matching the parameters is found in store. + "Return non-nil if an ENTRY matching the parameters is found in store. HOSTNAME, USER and PORT are passed unchanged to `auth-source-pass--matching-entries'." @@ -166,7 +166,7 @@ HOSTNAME, USER and PORT are passed unchanged to (auth-source-pass--matching-entries hostname user port))) (defun auth-source-pass-match-any-entry-p (hostname &optional user port) - "Return non-nil iff there is at least one entry matching the parameters. + "Return non-nil if there is at least one entry matching the parameters. HOSTNAME, USER and PORT are passed unchanged to `auth-source-pass--matching-entries'." @@ -466,7 +466,10 @@ HOSTNAME, USER and PORT are passed unchanged to (ert-deftest auth-source-pass-can-start-from-auth-source-search () (auth-source-pass--with-store '(("gitlab.com" ("user" . "someone"))) (auth-source-pass-enable) - (let ((result (car (auth-source-search :host "gitlab.com")))) + ;; This also asserts an aspect of traditional search behavior + ;; relative to `auth-source-pass-extra-query-keywords'. + (let* ((auth-source-pass-extra-query-keywords nil) + (result (car (auth-source-search :host "gitlab.com")))) (should (equal (plist-get result :user) "someone")) (should (equal (plist-get result :host) "gitlab.com"))))) @@ -488,6 +491,266 @@ HOSTNAME, USER and PORT are passed unchanged to (should (auth-source-pass--have-message-matching "found 2 entries matching \"gitlab.com\": (\"a/gitlab.com\" \"b/gitlab.com\")")))) + +;;;; Option `auth-source-pass-extra-query-keywords' (bug#58985) + +;; No entry has the requested port, but a result is still returned. + +(ert-deftest auth-source-pass-extra-query-keywords--wild-port-miss-netrc () + (ert-with-temp-file netrc-file + :text "\ +machine x.com password a +machine x.com port 42 password b +" + (let* ((auth-sources (list netrc-file)) + (auth-source-do-cache nil) + (results (auth-source-search :host "x.com" :port 22 :max 2))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results '((:host "x.com" :secret "a"))))))) + +(ert-deftest auth-source-pass-extra-query-keywords--wild-port-miss () + (auth-source-pass--with-store '(("x.com" (secret . "a")) + ("x.com:42" (secret . "b"))) + (auth-source-pass-enable) + (let* ((auth-source-pass-extra-query-keywords t) + (results (auth-source-search :host "x.com" :port 22 :max 2))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results '((:host "x.com" :secret "a"))))))) + +;; One of two entries has the requested port, both returned. + +(ert-deftest auth-source-pass-extra-query-keywords--wild-port-hit-netrc () + (ert-with-temp-file netrc-file + :text "\ +machine x.com password a +machine x.com port 42 password b +" + (let* ((auth-sources (list netrc-file)) + (auth-source-do-cache nil) + (results (auth-source-search :host "x.com" :port 42 :max 2))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results '((:host "x.com" :secret "a") + (:host "x.com" :port "42" :secret "b"))))))) + +(ert-deftest auth-source-pass-extra-query-keywords--wild-port-hit () + (auth-source-pass--with-store '(("x.com" (secret . "a")) + ("x.com:42" (secret . "b"))) + (auth-source-pass-enable) + (let* ((auth-source-pass-extra-query-keywords t) + (results (auth-source-search :host "x.com" :port 42 :max 2))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results + '((:host "x.com" :secret "a") + (:host "x.com" :port 42 :secret "b"))))))) + +;; No entry has the requested port, but :port is required, so search fails. + +(ert-deftest auth-source-pass-extra-query-keywords--wild-port-req-miss-netrc () + (ert-with-temp-file netrc-file + :text "\ +machine x.com password a +machine x.com port 42 password b +" + (let* ((auth-sources (list netrc-file)) + (auth-source-do-cache nil) + (results (auth-source-search + :host "x.com" :port 22 :require '(:port) :max 2))) + (should-not results)))) + +(ert-deftest auth-source-pass-extra-query-keywords--wild-port-req-miss () + (let ((auth-source-pass-extra-query-keywords t)) + (auth-source-pass--with-store '(("x.com" (secret . "a")) + ("x.com:42" (secret . "b"))) + (auth-source-pass-enable) + (should-not (auth-source-search + :host "x.com" :port 22 :require '(:port) :max 2))))) + +;; Specifying a :host without a :user finds a lone entry and does not +;; include extra fields (i.e., :port nil) in the result. +;; https://lists.gnu.org/archive/html/emacs-devel/2022-11/msg00130.html + +(ert-deftest auth-source-pass-extra-query-keywords--netrc-akib () + (ert-with-temp-file netrc-file + :text "\ +machine x.com password a +machine disroot.org user akib password b +machine z.com password c +" + (let* ((auth-sources (list netrc-file)) + (auth-source-do-cache nil) + (results (auth-source-search :host "disroot.org" :max 2))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results + '((:host "disroot.org" :user "akib" :secret "b"))))))) + +(ert-deftest auth-source-pass-extra-query-keywords--akib () + (auth-source-pass--with-store '(("x.com" (secret . "a")) + ("akib@disroot.org" (secret . "b")) + ("z.com" (secret . "c"))) + (auth-source-pass-enable) + (let* ((auth-source-pass-extra-query-keywords t) + (results (auth-source-search :host "disroot.org" :max 2))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results + '((:host "disroot.org" :user "akib" :secret "b"))))))) + +;; Searches for :host are case-sensitive, and a returned host isn't +;; normalized. + +(ert-deftest auth-source-pass-extra-query-keywords--netrc-host () + (ert-with-temp-file netrc-file + :text "\ +machine libera.chat password a +machine Libera.Chat password b +" + (let* ((auth-sources (list netrc-file)) + (auth-source-do-cache nil) + (results (auth-source-search :host "Libera.Chat" :max 2))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results '((:host "Libera.Chat" :secret "b"))))))) + +(ert-deftest auth-source-pass-extra-query-keywords--host () + (auth-source-pass--with-store '(("libera.chat" (secret . "a")) + ("Libera.Chat" (secret . "b"))) + (auth-source-pass-enable) + (let* ((auth-source-pass-extra-query-keywords t) + (results (auth-source-search :host "Libera.Chat" :max 2))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results + '((:host "Libera.Chat" :secret "b"))))))) + + +;; A retrieved store entry mustn't be nil regardless of whether its +;; path contains port or user components. + +(ert-deftest auth-source-pass-extra-query-keywords--baseline () + (let ((auth-source-pass-extra-query-keywords t)) + (auth-source-pass--with-store '(("x.com")) + (auth-source-pass-enable) + (should-not (auth-source-search :host "x.com"))))) + +;; Output port type (int or string) matches that of input parameter. + +(ert-deftest auth-source-pass-extra-query-keywords--port-type () + (let ((auth-source-pass-extra-query-keywords t) + (f (lambda (r) (setf (plist-get r :secret) (auth-info-password r)) r))) + (auth-source-pass--with-store '(("x.com:42" (secret . "a"))) + (auth-source-pass-enable) + (should (equal (mapcar f (auth-source-search :host "x.com" :port 42)) + '((:host "x.com" :port 42 :secret "a"))))) + (auth-source-pass--with-store '(("x.com:42" (secret . "a"))) + (auth-source-pass-enable) + (should (equal (mapcar f (auth-source-search :host "x.com" :port "42")) + '((:host "x.com" :port "42" :secret "a"))))))) + +;; Match precision sometimes takes a back seat to the traversal +;; ordering. Specifically, the :host (h1, ...) args hold greater sway +;; over the output because they determine the first coordinate in the +;; sequence of (host, user, port) combinations visited. (Taking a +;; tree-wise view, these become the depth-1 nodes in a DFS.) + +;; Note that all trailing /user forms are demoted for the sake of +;; predictability (see tests further below for details). This means +;; that, in the following test, /bar is held in limbo, followed by +;; /foo, but they both retain priority over "gnu.org", as noted above. + +(ert-deftest auth-source-pass-extra-query-keywords--hosts-first () + (auth-source-pass--with-store '(("x.com:42/bar" (secret . "a")) + ("gnu.org" (secret . "b")) + ("x.com" (secret . "c")) + ("fake.com" (secret . "d")) + ("x.com/foo" (secret . "e"))) + (auth-source-pass-enable) + (let* ((auth-source-pass-extra-query-keywords t) + (results (auth-source-search :host '("x.com" "gnu.org") :max 3))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results + ;; Notice gnu.org is never considered ^ + '((:host "x.com" :secret "c") + (:host "x.com" :user "bar" :port "42" :secret "a") + (:host "x.com" :user "foo" :secret "e"))))))) + +;; This is another example given in the bug thread. + +(ert-deftest auth-source-pass-extra-query-keywords--ambiguous-user-host () + (auth-source-pass--with-store '(("foo.com/bar.org" (secret . "a")) + ("foo.com" (secret . "b")) + ("bar.org" (secret . "c")) + ("fake.com" (secret . "d"))) + (auth-source-pass-enable) + (let* ((auth-source-pass-extra-query-keywords t) + (results (auth-source-search :host "bar.org" :max 3))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results '((:host "bar.org" :secret "c"))))))) + +;; This conveys the same idea as `user-priorities', just below, but +;; with slightly more realistic and less legible values. + +(ert-deftest auth-source-pass-extra-query-keywords--suffixed-user () + (let ((store (sort (copy-sequence '(("x.com:42/bar" (secret . "a")) + ("bar@x.com" (secret . "b")) + ("x.com" (secret . "?")) + ("bar@y.org" (secret . "c")) + ("fake.com" (secret . "?")) + ("fake.com/bar" (secret . "d")) + ("y.org/bar" (secret . "?")) + ("bar@fake.com" (secret . "e")))) + (lambda (&rest _) (zerop (random 2)))))) + (auth-source-pass--with-store store + (auth-source-pass-enable) + (let* ((auth-source-pass-extra-query-keywords t) + (results (auth-source-search :host '("x.com" "fake.com" "y.org") + :user "bar" + :require '(:user) :max 5))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results + '((:host "x.com" :user "bar" :secret "b") + (:host "x.com" :user "bar" :port "42" :secret "a") + (:host "fake.com" :user "bar" :secret "e") + (:host "fake.com" :user "bar" :secret "d") + (:host "y.org" :user "bar" :secret "c")))))))) + +;; This is a more distilled version of `suffixed-user', above. It +;; better illustrates that search order takes precedence over "/user" +;; demotion because otherwise * and ** would be swapped, below. It +;; follows that omitting the :port 2, gets you {u@h:1, u@h:2, h:1/u, +;; h:2/u, u@g:1}. + +(ert-deftest auth-source-pass-extra-query-keywords--user-priorities () + (let ((store (sort (copy-sequence '(("h:1/u" (secret . "/")) + ("h:2/u" (secret . "/")) + ("u@h:1" (secret . "@")) + ("u@h:2" (secret . "@")) + ("g:1/u" (secret . "/")) + ("g:2/u" (secret . "/")) + ("u@g:1" (secret . "@")) + ("u@g:2" (secret . "@")))) + (lambda (&rest _) (zerop (random 2)))))) + (auth-source-pass--with-store store + (auth-source-pass-enable) + (let* ((auth-source-pass-extra-query-keywords t) + (results (auth-source-search :host '("h" "g") + :port 2 + :max 5))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results + '((:host "h" :user "u" :port 2 :secret "@") + (:host "h" :user "u" :port 2 :secret "/") ; * + (:host "g" :user "u" :port 2 :secret "@") ; ** + (:host "g" :user "u" :port 2 :secret "/")))))))) + (provide 'auth-source-pass-tests) ;;; auth-source-pass-tests.el ends here diff --git a/test/lisp/cedet/srecode/fields-tests.el b/test/lisp/cedet/srecode/fields-tests.el index 292ac4e3b5e..c9e0d4601b9 100644 --- a/test/lisp/cedet/srecode/fields-tests.el +++ b/test/lisp/cedet/srecode/fields-tests.el @@ -66,7 +66,7 @@ It is filled with some text." (when (and (overlayp (oref f overlay)) (not (overlay-get (oref f overlay) 'srecode-init-only))) - (error "Field creation overlay is not tagged w/ init flag")) + (error "Field creation overlay is not tagged with init flag")) (srecode-overlaid-activate f) diff --git a/test/lisp/dired-tests.el b/test/lisp/dired-tests.el index 09becc7fe7a..18b0257e01a 100644 --- a/test/lisp/dired-tests.el +++ b/test/lisp/dired-tests.el @@ -354,6 +354,17 @@ (should (equal "subdir" (dired-get-filename 'local t))))))) +(ert-deftest dired-test-bug59047 () + "Test for https://debbugs.gnu.org/59047 ." + (dired (list (expand-file-name "src" source-directory) + "cygw32.c" "alloc.c" "w32xfns.c" "xdisp.c")) + (dired-hide-all) + (dired-hide-all) + (dired-next-line 1) + (should (equal 'dired-hide-details-detail + (get-text-property + (1+ (line-beginning-position)) 'invisible)))) + (defmacro dired-test-with-temp-dirs (just-empty-dirs &rest body) "Helper macro for Bug#27940 test." (declare (indent 1) (debug body)) diff --git a/test/lisp/emacs-lisp/cl-macs-tests.el b/test/lisp/emacs-lisp/cl-macs-tests.el index f742637ee35..160ac591130 100644 --- a/test/lisp/emacs-lisp/cl-macs-tests.el +++ b/test/lisp/emacs-lisp/cl-macs-tests.el @@ -803,4 +803,10 @@ See Bug#57915." (macroexpand form) (should (string-empty-p messages)))))))) +(ert-deftest cl-&key-arguments () + (cl-flet ((fn (&key x) x)) + (should-error (fn :x)) + (should (eq (fn :x :a) :a)))) + + ;;; cl-macs-tests.el ends here diff --git a/test/lisp/emacs-lisp/package-resources/elpa-packages.eld b/test/lisp/emacs-lisp/package-resources/elpa-packages.eld new file mode 100644 index 00000000000..7884aac278e --- /dev/null +++ b/test/lisp/emacs-lisp/package-resources/elpa-packages.eld @@ -0,0 +1,3 @@ +;; Dummy elpa-package.eld + +(() :version 1) diff --git a/test/lisp/emacs-lisp/package-resources/newer-versions/elpa-packages.eld b/test/lisp/emacs-lisp/package-resources/newer-versions/elpa-packages.eld new file mode 100644 index 00000000000..7884aac278e --- /dev/null +++ b/test/lisp/emacs-lisp/package-resources/newer-versions/elpa-packages.eld @@ -0,0 +1,3 @@ +;; Dummy elpa-package.eld + +(() :version 1) diff --git a/test/lisp/emacs-lisp/package-resources/signed/elpa-packages.eld b/test/lisp/emacs-lisp/package-resources/signed/elpa-packages.eld new file mode 100644 index 00000000000..7884aac278e --- /dev/null +++ b/test/lisp/emacs-lisp/package-resources/signed/elpa-packages.eld @@ -0,0 +1,3 @@ +;; Dummy elpa-package.eld + +(() :version 1) diff --git a/test/lisp/emacs-lisp/package-resources/signed/elpa-packages.eld.sig b/test/lisp/emacs-lisp/package-resources/signed/elpa-packages.eld.sig Binary files differnew file mode 100644 index 00000000000..39202ca75e0 --- /dev/null +++ b/test/lisp/emacs-lisp/package-resources/signed/elpa-packages.eld.sig diff --git a/test/lisp/emacs-lisp/package-resources/signed/update-signatures.sh b/test/lisp/emacs-lisp/package-resources/signed/update-signatures.sh index 30e74156c01..ddd96748ec1 100755 --- a/test/lisp/emacs-lisp/package-resources/signed/update-signatures.sh +++ b/test/lisp/emacs-lisp/package-resources/signed/update-signatures.sh @@ -30,4 +30,5 @@ rm $KEYRING #$GPG --export-secret-keys -armor > "../key.sec" $GPG --import ../key.sec $GPG --detach-sign --sign "./archive-contents" +$GPG --detach-sign --sign "./elpa-packages.eld" $GPG --detach-sign --sign "./signed-good-1.0.el" diff --git a/test/lisp/emacs-lisp/package-resources/with-nil-entry/elpa-packages.eld b/test/lisp/emacs-lisp/package-resources/with-nil-entry/elpa-packages.eld new file mode 100644 index 00000000000..7884aac278e --- /dev/null +++ b/test/lisp/emacs-lisp/package-resources/with-nil-entry/elpa-packages.eld @@ -0,0 +1,3 @@ +;; Dummy elpa-package.eld + +(() :version 1) diff --git a/test/lisp/emacs-lisp/syntax-tests.el b/test/lisp/emacs-lisp/syntax-tests.el index f266db5c702..d8fc5c4fa82 100644 --- a/test/lisp/emacs-lisp/syntax-tests.el +++ b/test/lisp/emacs-lisp/syntax-tests.el @@ -56,7 +56,7 @@ "\\(?2:[abc]+\\)foo\\(\\2\\)" 2) "\\(?4:[abc]+\\)foo\\(\\4\\)")) ;; Emacs supports only the back-references \1,...,\9, so when a - ;; shift would result in \10 or more, an error must be signalled. + ;; shift would result in \10 or more, an error must be signaled. (should-error (syntax-propertize--shift-groups-and-backrefs "\\(a\\)\\3" 7))) diff --git a/test/lisp/erc/erc-dcc-tests.el b/test/lisp/erc/erc-dcc-tests.el index 8645d7f1044..74cbb7d9476 100644 --- a/test/lisp/erc/erc-dcc-tests.el +++ b/test/lisp/erc/erc-dcc-tests.el @@ -167,7 +167,8 @@ (defun erc-dcc-tests--pcomplete-common (test-fn) (with-current-buffer (get-buffer-create "*erc-dcc-do-GET-command*") - (let* ((proc (start-process "fake" (current-buffer) "sleep" "10")) + (let* ((inhibit-message noninteractive) + (proc (start-process "fake" (current-buffer) "sleep" "10")) (elt (list :nick "tester!~tester@fake.irc" :type 'GET :peer nil diff --git a/test/lisp/erc/erc-networks-tests.el b/test/lisp/erc/erc-networks-tests.el index 32bdfa11ff7..fc12bf7ce37 100644 --- a/test/lisp/erc/erc-networks-tests.el +++ b/test/lisp/erc/erc-networks-tests.el @@ -1704,4 +1704,21 @@ (erc-networks-tests--clean-bufs)) +(ert-deftest erc-networks--determine () + (should (eq (erc-networks--determine "irc.libera.chat") 'Libera.Chat)) + (should (eq (erc-networks--determine "irc.oftc.net") 'OFTC)) + (should (eq (erc-networks--determine "irc.dal.net") 'DALnet)) + + (let ((erc-server-announced-name "zirconium.libera.chat")) + (should (eq (erc-networks--determine) 'Libera.Chat))) + (let ((erc-server-announced-name "weber.oftc.net")) + (should (eq (erc-networks--determine) 'OFTC))) + (let ((erc-server-announced-name "redemption.ix.us.dal.net")) + (should (eq (erc-networks--determine) 'DALnet))) + + ;; Failure + (let ((erc-server-announced-name "irc-us2.alphachat.net")) + (should (eq (erc-networks--determine) + erc-networks--name-missing-sentinel)))) + ;;; erc-networks-tests.el ends here diff --git a/test/lisp/erc/erc-scenarios-base-reconnect.el b/test/lisp/erc/erc-scenarios-base-reconnect.el index 49298dc5942..8762f33b303 100644 --- a/test/lisp/erc/erc-scenarios-base-reconnect.el +++ b/test/lisp/erc/erc-scenarios-base-reconnect.el @@ -224,4 +224,50 @@ (with-current-buffer "#chan" (funcall expect 10 "here comes the lady"))))) + +(ert-deftest erc-scenarios-base-cancel-reconnect () + :tags '(:expensive-test) + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "base/reconnect") + (dumb-server (erc-d-run "localhost" t 'timer 'timer 'timer-last)) + (port (process-contact dumb-server :service)) + (expect (erc-d-t-make-expecter)) + (erc-server-auto-reconnect t) + erc-autojoin-channels-alist + erc-server-buffer) + + (ert-info ("Connect to foonet") + (setq erc-server-buffer (erc :server "127.0.0.1" + :port port + :nick "tester" + :password "changeme" + :full-name "tester")) + (with-current-buffer erc-server-buffer + (should (string= (buffer-name) (format "127.0.0.1:%d" port))))) + + (ert-info ("Two connection attempts, all stymied") + (with-current-buffer erc-server-buffer + (ert-info ("First two attempts behave normally") + (dotimes (n 2) + (ert-info ((format "Initial attempt %d" (1+ n))) + (funcall expect 3 "Opening connection") + (funcall expect 2 "Password incorrect") + (funcall expect 2 "Connection failed!") + (funcall expect 2 "Re-establishing connection")))) + (ert-info ("/RECONNECT cancels timer but still attempts to connect") + (erc-cmd-RECONNECT) + (funcall expect 2 "Canceled") + (funcall expect 3 "Opening connection") + (funcall expect 2 "Password incorrect") + (funcall expect 2 "Connection failed!") + (funcall expect 2 "Re-establishing connection")) + (ert-info ("Explicitly cancel timer") + (erc-cmd-RECONNECT "cancel") + (funcall expect 2 "Canceled") + (erc-d-t-absent-for 1 "Opening connection" (point))))) + + (ert-info ("Server buffer is unique and temp name is absent") + (should (equal (list (get-buffer (format "127.0.0.1:%d" port))) + (erc-scenarios-common-buflist "127.0.0.1")))))) + ;;; erc-scenarios-base-reconnect.el ends here diff --git a/test/lisp/erc/erc-scenarios-misc.el b/test/lisp/erc/erc-scenarios-misc.el index ded620ccc1d..8557a779069 100644 --- a/test/lisp/erc/erc-scenarios-misc.el +++ b/test/lisp/erc/erc-scenarios-misc.el @@ -177,4 +177,32 @@ (erc-scenarios-common-say "Hi") (funcall expect 10 "Hola"))))) +(defvar url-irc-function) + +(ert-deftest erc-scenarios-handle-irc-url () + :tags '(:expensive-test) + (erc-scenarios-common-with-cleanup + ((erc-scenarios-common-dialog "join/legacy") + (dumb-server (erc-d-run "localhost" t 'foonet)) + (port (process-contact dumb-server :service)) + (expect (erc-d-t-make-expecter)) + (url-irc-function 'url-irc-erc) + (erc-url-connect-function + (lambda (scheme &rest r) + (ert-info ("Connect to foonet") + (should (equal scheme "irc")) + (with-current-buffer (apply #'erc `(:full-name "tester" ,@r)) + (should (string= (buffer-name) + (format "127.0.0.1:%d" port))) + (current-buffer)))))) + + (with-temp-buffer + (insert (format ";; irc://tester:changeme@127.0.0.1:%d/#chan" port)) + (goto-char 10) + (browse-url-at-point)) + + (ert-info ("Connected") + (with-current-buffer (erc-d-t-wait-for 10 (get-buffer "#chan")) + (funcall expect 10 "welcome"))))) + ;;; erc-scenarios-misc.el ends here diff --git a/test/lisp/erc/erc-services-tests.el b/test/lisp/erc/erc-services-tests.el index c22d4cf75ef..7ff2e36e77c 100644 --- a/test/lisp/erc/erc-services-tests.el +++ b/test/lisp/erc/erc-services-tests.el @@ -474,7 +474,6 @@ ("GNU.chat:irc/#chan" (secret . "foo")))) (ert-deftest erc--auth-source-search--pass-standard () - (ert-skip "Pass backend not yet supported") (let ((store erc-join-tests--auth-source-pass-entries) (auth-sources '(password-store)) (auth-source-do-cache nil)) @@ -487,7 +486,6 @@ (erc-services-tests--auth-source-standard #'erc-auth-source-search)))) (ert-deftest erc--auth-source-search--pass-announced () - (ert-skip "Pass backend not yet supported") (let ((store erc-join-tests--auth-source-pass-entries) (auth-sources '(password-store)) (auth-source-do-cache nil)) @@ -500,7 +498,6 @@ (erc-services-tests--auth-source-announced #'erc-auth-source-search)))) (ert-deftest erc--auth-source-search--pass-overrides () - (ert-skip "Pass backend not yet supported") (let ((store `(,@erc-join-tests--auth-source-pass-entries ("GNU.chat:6697/#chan" (secret . "spam")) diff --git a/test/lisp/erc/erc-tests.el b/test/lisp/erc/erc-tests.el index c88dd9888d8..ff5d8026973 100644 --- a/test/lisp/erc/erc-tests.el +++ b/test/lisp/erc/erc-tests.el @@ -953,4 +953,229 @@ (kill-buffer "ExampleNet") (kill-buffer "#chan"))) +(defvar erc-tests--ipv6-examples + '("1:2:3:4:5:6:7:8" + "::ffff:10.0.0.1" "::ffff:1.2.3.4" "::ffff:0.0.0.0" + "1:2:3:4:5:6:77:88" "::ffff:255.255.255.255" + "fe08::7:8" "ffff:ffff:ffff:ffff:ffff:ffff:ffff:ffff" + "1:2:3:4:5:6:7:8" "1::" "1:2:3:4:5:6:7::" "1::8" + "1:2:3:4:5:6::8" "1:2:3:4:5:6::8" "1::7:8" "1:2:3:4:5::7:8" + "1:2:3:4:5::8" "1::6:7:8" "1:2:3:4::6:7:8" "1:2:3:4::8" + "1::5:6:7:8" "1:2:3::5:6:7:8" "1:2:3::8" "1::4:5:6:7:8" + "1:2::4:5:6:7:8" "1:2::8" "1::3:4:5:6:7:8" "1::3:4:5:6:7:8" + "1::8" "::2:3:4:5:6:7:8" "::2:3:4:5:6:7:8" "::8" + "::" "fe08::7:8%eth0" "fe08::7:8%1" "::255.255.255.255" + "::ffff:255.255.255.255" "::ffff:0:255.255.255.255" + "2001:db8:3:4::192.0.2.33" "64:ff9b::192.0.2.33")) + +(ert-deftest erc--server-connect-dumb-ipv6-regexp () + (dolist (a erc-tests--ipv6-examples) + (should-not (string-match erc--server-connect-dumb-ipv6-regexp a)) + (should (string-match erc--server-connect-dumb-ipv6-regexp + (concat "[" a "]"))))) + +(ert-deftest erc-select-read-args () + + (ert-info ("Defaults to TLS") + (should (equal (ert-simulate-keys "\r\r\r\r" + (erc-select-read-args)) + (list :server "irc.libera.chat" + :port 6697 + :nick (user-login-name) + :password nil)))) + + (ert-info ("Override default TLS") + (should (equal (ert-simulate-keys "irc://irc.libera.chat\r\r\r\r" + (erc-select-read-args)) + (list :server "irc.libera.chat" + :port 6667 + :nick (user-login-name) + :password nil)))) + + (ert-info ("Address includes port") + (should (equal (ert-simulate-keys + "localhost:6667\rnick\r\r" + (erc-select-read-args)) + (list :server "localhost" + :port 6667 + :nick "nick" + :password nil)))) + + (ert-info ("Address includes nick, password skipped via option") + (should (equal (ert-simulate-keys "nick@localhost:6667\r" + (let (erc-prompt-for-password) + (erc-select-read-args))) + (list :server "localhost" + :port 6667 + :nick "nick" + :password nil)))) + + (ert-info ("Address includes nick and password") + (should (equal (ert-simulate-keys "nick:sesame@localhost:6667\r" + (erc-select-read-args)) + (list :server "localhost" + :port 6667 + :nick "nick" + :password "sesame")))) + + (ert-info ("IPv6 address plain") + (should (equal (ert-simulate-keys "::1\r\r\r\r" + (erc-select-read-args)) + (list :server "[::1]" + :port 6667 + :nick (user-login-name) + :password nil)))) + + (ert-info ("IPv6 address with port") + (should (equal (ert-simulate-keys "[::1]:6667\r\r\r" + (erc-select-read-args)) + (list :server "[::1]" + :port 6667 + :nick (user-login-name) + :password nil)))) + + (ert-info ("IPv6 address includes nick") + (should (equal (ert-simulate-keys "nick@[::1]:6667\r\r" + (erc-select-read-args)) + (list :server "[::1]" + :port 6667 + :nick "nick" + :password nil))))) + +(ert-deftest erc-tls () + (let (calls) + (cl-letf (((symbol-function 'user-login-name) + (lambda (&optional _) "tester")) + ((symbol-function 'erc-open) + (lambda (&rest r) (push r calls)))) + + (ert-info ("Defaults") + (erc-tls) + (should (equal (pop calls) + '("irc.libera.chat" 6697 "tester" "unknown" t + nil nil nil nil nil "user" nil)))) + + (ert-info ("Full") + (erc-tls :server "irc.gnu.org" + :port 7000 + :user "bobo" + :nick "bob" + :full-name "Bob's Name" + :password "bob:changeme" + :client-certificate t + :id 'GNU.org) + (should (equal (pop calls) + '("irc.gnu.org" 7000 "bob" "Bob's Name" t + "bob:changeme" nil nil nil t "bobo" GNU.org)))) + + ;; Values are often nil when called by lisp code, which leads to + ;; null params. This is why `erc-open' recomputes almost + ;; everything. + (ert-info ("Fallback") + (let ((erc-nick "bob") + (erc-server "irc.gnu.org") + (erc-email-userid "bobo") + (erc-user-full-name "Bob's Name")) + (erc-tls :server nil + :port 7000 + :nick nil + :password "bob:changeme")) + (should (equal (pop calls) + '(nil 7000 nil "Bob's Name" t + "bob:changeme" nil nil nil nil "bobo" nil))))))) + +(defun erc-tests--make-server-buf (name) + (with-current-buffer (get-buffer-create name) + (erc-mode) + (setq erc-server-process (start-process "sleep" (current-buffer) + "sleep" "1") + erc-session-server (concat "irc." name ".org") + erc-session-port 6667 + erc-network (intern name)) + (set-process-query-on-exit-flag erc-server-process nil) + (current-buffer))) + +(defun erc-tests--make-client-buf (server name) + (unless (bufferp server) + (setq server (get-buffer server))) + (with-current-buffer (get-buffer-create name) + (erc-mode) + (setq erc--target (erc--target-from-string name)) + (dolist (v '(erc-server-process + erc-session-server + erc-session-port + erc-network)) + (set v (buffer-local-value v server))) + (current-buffer))) + +(ert-deftest erc-handle-irc-url () + (let* (calls + rvbuf + erc-networks-alist + erc-kill-channel-hook erc-kill-server-hook erc-kill-buffer-hook + (erc-url-connect-function + (lambda (&rest r) + (push r calls) + (if (functionp rvbuf) (funcall rvbuf) rvbuf)))) + + (cl-letf (((symbol-function 'erc-cmd-JOIN) + (lambda (&rest r) (push r calls)))) + + (with-current-buffer (erc-tests--make-server-buf "foonet") + (setq rvbuf (current-buffer))) + (erc-tests--make-server-buf "barnet") + (erc-tests--make-server-buf "baznet") + + (ert-info ("Unknown network") + (erc-handle-irc-url "irc.foonet.org" 6667 "#chan" nil nil "irc") + (should (equal '("#chan" nil) (pop calls))) + (should-not calls)) + + (ert-info ("Unknown network, no port") + (erc-handle-irc-url "irc.foonet.org" nil "#chan" nil nil "irc") + (should (equal '("#chan" nil) (pop calls))) + (should-not calls)) + + (ert-info ("Known network, no port") + (setq erc-networks-alist '((foonet "irc.foonet.org"))) + (erc-handle-irc-url "irc.foonet.org" nil "#chan" nil nil "irc") + (should (equal '("#chan" nil) (pop calls))) + (should-not calls)) + + (ert-info ("Known network, different port") + (erc-handle-irc-url "irc.foonet.org" 6697 "#chan" nil nil "irc") + (should (equal '("#chan" nil) (pop calls))) + (should-not calls)) + + (ert-info ("Known network, existing chan with key") + (erc-tests--make-client-buf "foonet" "#chan") + (erc-handle-irc-url "irc.foonet.org" nil "#chan?sec" nil nil "irc") + (should (equal '("#chan" "sec") (pop calls))) + (should-not calls)) + + (ert-info ("Unknown network, connect, no chan") + (erc-handle-irc-url "irc.gnu.org" nil nil nil nil "irc") + (should (equal '("irc" :server "irc.gnu.org") (pop calls))) + (should-not calls)) + + (ert-info ("Unknown network, connect, chan") + (with-current-buffer "foonet" + (should-not (local-variable-p 'erc-after-connect))) + (setq rvbuf (lambda () (erc-tests--make-server-buf "gnu"))) + (erc-handle-irc-url "irc.gnu.org" nil "#spam" nil nil "irc") + (should (equal '("irc" :server "irc.gnu.org") (pop calls))) + (should-not calls) + (with-current-buffer "gnu" + (should (local-variable-p 'erc-after-connect)) + (funcall (car erc-after-connect)) + (should (equal '("#spam" nil) (pop calls))) + (should-not (local-variable-p 'erc-after-connect))) + (should-not calls)))) + + (when noninteractive + (kill-buffer "foonet") + (kill-buffer "barnet") + (kill-buffer "baznet") + (kill-buffer "#chan"))) + ;;; erc-tests.el ends here diff --git a/test/lisp/erc/resources/erc-d/erc-d-tests.el b/test/lisp/erc/resources/erc-d/erc-d-tests.el index a4befd96b5e..8dd5cef7aa2 100644 --- a/test/lisp/erc/resources/erc-d/erc-d-tests.el +++ b/test/lisp/erc/resources/erc-d/erc-d-tests.el @@ -562,6 +562,7 @@ DUMB-SERVER-VAR are bound accordingly in BODY." ;; (erc-server-flood-penalty 0.05) erc-autojoin-channels-alist + erc-after-connect erc-server-auto-reconnect) (should-not erc-d--slow-mo) (with-current-buffer "*erc-d-server*" (erc-d-t-search-for 4 "Starting")) diff --git a/test/lisp/erc/resources/erc-scenarios-common.el b/test/lisp/erc/resources/erc-scenarios-common.el index bc2cb68cd86..ef65125241f 100644 --- a/test/lisp/erc/resources/erc-scenarios-common.el +++ b/test/lisp/erc/resources/erc-scenarios-common.el @@ -73,7 +73,7 @@ (require 'erc-d-t) (require 'erc-d))) -(require 'erc-backend) +(require 'erc) (eval-when-compile (require 'erc-join) (require 'erc-services)) @@ -125,6 +125,7 @@ (erc-auth-source-parameters-join-function nil) (erc-autojoin-channels-alist nil) (erc-server-auto-reconnect nil) + (erc-after-connect nil) (erc-d-linger-secs 10) ,@bindings))) diff --git a/test/lisp/erc/resources/join/legacy/foonet.eld b/test/lisp/erc/resources/join/legacy/foonet.eld index 344ba7c1daf..4025094a59c 100644 --- a/test/lisp/erc/resources/join/legacy/foonet.eld +++ b/test/lisp/erc/resources/join/legacy/foonet.eld @@ -1,5 +1,5 @@ ;; -*- mode: lisp-data; -*- -((pass 1 "PASS :changeme")) +((pass 10 "PASS :changeme")) ((nick 1 "NICK tester")) ((user 1 "USER user 0 * :tester") (0 ":irc.foonet.org 001 tester :Welcome to the foonet IRC Network tester") diff --git a/test/lisp/net/browse-url-tests.el b/test/lisp/net/browse-url-tests.el index 1c993958b81..dc819768211 100644 --- a/test/lisp/net/browse-url-tests.el +++ b/test/lisp/net/browse-url-tests.el @@ -56,6 +56,15 @@ 'browse-url--man)) (should-not (browse-url-select-handler "man:ls" 'external))) +(ert-deftest browse-url-tests-select-handler-irc () + (should (eq (browse-url-select-handler "irc://localhost" 'internal) + 'browse-url--irc)) + (should-not (browse-url-select-handler "irc://localhost" 'external)) + (should (eq (browse-url-select-handler "irc6://localhost") + 'browse-url--irc)) + (should (eq (browse-url-select-handler "ircs://tester@irc.gnu.org/#chan") + 'browse-url--irc))) + (ert-deftest browse-url-tests-select-handler-file () (should (eq (browse-url-select-handler "file://foo.txt") 'browse-url-emacs)) diff --git a/test/lisp/net/dbus-tests.el b/test/lisp/net/dbus-tests.el index 76318429181..c808e6350ea 100644 --- a/test/lisp/net/dbus-tests.el +++ b/test/lisp/net/dbus-tests.el @@ -407,7 +407,7 @@ :session dbus--test-service '(:array (:dict-entry :string "string" :boolean t :boolean t))) :type 'wrong-type-argument) - ;; The first element ist not of a basic type. + ;; The first element is not of a basic type. (should-error (dbus-check-arguments :session dbus--test-service @@ -1093,7 +1093,7 @@ is in progress." (dbus-unregister-service :session dbus--test-service))) (ert-deftest dbus-test06-register-property-emits-signal () - "Check property registration for an own service, including signalling." + "Check property registration for an own service, including signaling." (skip-unless dbus--test-enabled-session-bus) (dbus-ignore-errors (dbus-unregister-service :session dbus--test-service)) @@ -1136,7 +1136,7 @@ is in progress." dbus--test-interface property) "foo")) - ;; Set property. The new value shall be signalled. + ;; Set property. The new value shall be signaled. (setq dbus--test-signal-received nil) (should (equal diff --git a/test/lisp/net/eudc-resources/bbdb b/test/lisp/net/eudc-resources/bbdb new file mode 100644 index 00000000000..b730bb51cc9 --- /dev/null +++ b/test/lisp/net/eudc-resources/bbdb @@ -0,0 +1,3 @@ +;; -*- mode: Emacs-Lisp; coding: utf-8; -*- +;;; file-format: 9 +["Emacs" "ERT3" nil nil nil nil nil ("emacs-ert-test-3@bbdb.gnu.org") ((notes . " ")) "c8bd3a63-3a83-48a7-a95b-be118a923e00" "2022-11-19 16:36:04 +0000" "2022-11-19 16:36:04 +0000" nil] diff --git a/test/lisp/net/eudc-resources/dc=gnu,dc=org.ldif b/test/lisp/net/eudc-resources/dc=gnu,dc=org.ldif new file mode 100644 index 00000000000..9db4be20280 --- /dev/null +++ b/test/lisp/net/eudc-resources/dc=gnu,dc=org.ldif @@ -0,0 +1,15 @@ +# AUTO-GENERATED FILE - DO NOT EDIT!! Use ldapmodify. +# CRC32 12f0e8c3 +dn: dc=gnu +objectClass: dcObject +objectClass: organization +dc: gnu +o: The ldap.gnu.org organization +description: An organization for the following person +structuralObjectClass: organization +entryUUID: 43dd74ec-fc0d-103c-8d5c-7dbac5615d14 +creatorsName: +createTimestamp: 20221119042038Z +entryCSN: 20221119042038.100000Z#000000#000#000000 +modifiersName: +modifyTimestamp: 20221119042038Z diff --git a/test/lisp/net/eudc-resources/dc=gnu,dc=org/cn=emacs-ert-test-1.ldif b/test/lisp/net/eudc-resources/dc=gnu,dc=org/cn=emacs-ert-test-1.ldif new file mode 100644 index 00000000000..7828f179df2 --- /dev/null +++ b/test/lisp/net/eudc-resources/dc=gnu,dc=org/cn=emacs-ert-test-1.ldif @@ -0,0 +1,17 @@ +# AUTO-GENERATED FILE - DO NOT EDIT!! Use ldapmodify. +# CRC32 a33c0168 +dn: cn=emacs-ert-test-1 +objectClass: OpenLDAPperson +cn: emacs-ert-test-1 +description:: RW1hY3Mg +uid: 1 +sn: ERT1 +givenName: Emacs +mail: emacs-ert-test-1@ldap.gnu.org +structuralObjectClass: OpenLDAPperson +entryUUID: 43dd805e-fc0d-103c-8d5d-7dbac5615d14 +creatorsName: +createTimestamp: 20221119042038Z +entryCSN: 20221119042038.100350Z#000000#000#000000 +modifiersName: +modifyTimestamp: 20221119042038Z diff --git a/test/lisp/net/eudc-resources/dc=gnu,dc=org/cn=emacs-ert-test-2.ldif b/test/lisp/net/eudc-resources/dc=gnu,dc=org/cn=emacs-ert-test-2.ldif new file mode 100644 index 00000000000..d3de3d81c71 --- /dev/null +++ b/test/lisp/net/eudc-resources/dc=gnu,dc=org/cn=emacs-ert-test-2.ldif @@ -0,0 +1,17 @@ +# AUTO-GENERATED FILE - DO NOT EDIT!! Use ldapmodify. +# CRC32 56119237 +dn: cn=emacs-ert-test-2 +objectClass: OpenLDAPperson +cn: emacs-ert-test-2 +description:: RW1hY3Mg +uid: 2 +sn: ERT2 +givenName: Emacs +mail: emacs-ert-test-2@ldap.gnu.org +structuralObjectClass: OpenLDAPperson +entryUUID: 43dd92b0-fc0d-103c-8d5e-7dbac5615d14 +creatorsName: +createTimestamp: 20221119042038Z +entryCSN: 20221119042038.100819Z#000000#000#000000 +modifiersName: +modifyTimestamp: 20221119042038Z diff --git a/test/lisp/net/eudc-resources/ecompleterc b/test/lisp/net/eudc-resources/ecompleterc new file mode 100644 index 00000000000..9019b26c9f3 --- /dev/null +++ b/test/lisp/net/eudc-resources/ecompleterc @@ -0,0 +1,7 @@ +((mail + ("larsi@gnus.org" 38154 1516109510 "Lars Ingebrigtsen <larsi@ecomplete.org>") + ("kfogel@red-bean.com" 10 1516065455 "Karl Fogel <kfogel@ecomplete.com>") + ("behse@ecomplete.org" 10 1516065455 "behse@ecomplete.org")) + (phone + ("Lars Ingebrigtsen" 0 0 "+1 234 5678 9012") + ("Karl Fogel" 0 0 "+33 701 4567 8901"))) diff --git a/test/lisp/net/eudc-resources/mailrc b/test/lisp/net/eudc-resources/mailrc new file mode 100644 index 00000000000..c565f718372 --- /dev/null +++ b/test/lisp/net/eudc-resources/mailrc @@ -0,0 +1,3 @@ +alias lars "Lars Ingebrigtsen <larsi@mail-abbrev.com>" +alias karl "Karl Fogel <kfogel@mail-abbrev.com>" +alias emacsheroes lars karl diff --git a/test/lisp/net/eudc-resources/slapd.conf b/test/lisp/net/eudc-resources/slapd.conf new file mode 100644 index 00000000000..9afafe76764 --- /dev/null +++ b/test/lisp/net/eudc-resources/slapd.conf @@ -0,0 +1,7 @@ +include /etc/ldap/schema/core.schema +include /etc/ldap/schema/cosine.schema +include /etc/ldap/schema/inetorgperson.schema +include /etc/ldap/schema/openldap.schema +database ldif +directory eudc-resources +suffix "dc=gnu,dc=org" diff --git a/test/lisp/net/eudc-tests.el b/test/lisp/net/eudc-tests.el index 915006a97c1..212db65cb26 100644 --- a/test/lisp/net/eudc-tests.el +++ b/test/lisp/net/eudc-tests.el @@ -152,4 +152,160 @@ (should (eq 'b (eudc-lax-plist-get '(nil a "a" a) 'a 'b))) (should (eq 'b (eudc-lax-plist-get '(a nil "nil" nil) nil 'b))))) +;; eudc-rfc5322-quote-phrase (string) +(ert-deftest eudc-test-rfc5322-quote-phrase () + "Tests for RFC5322 compliant phrase quoting." + ;; atext-token "[:alpha:][:digit:]!#$%&'*+/=?^_`{|}~-" + (should (equal (eudc-rfc5322-quote-phrase "Foo Bar !#$%&'*+/=?^_`{|}~-") + "Foo Bar !#$%&'*+/=?^_`{|}~-")) + (should (equal (eudc-rfc5322-quote-phrase "Foo, Bar !#$%&'*+/=?^_`{|}~-") + "\"Foo, Bar !#$%&'*+/=?^_`{|}~-\""))) + +;; eudc-rfc5322-valid-comment-p (string) +(ert-deftest eudc-test-rfc5322-valid-comment-p () + "Tests for RFC5322 compliant comments." + ;; cctext-token "\u005D-\u007E\u002A-\u005B\u0021-\u0027" + fwsp-token (TAB, LF, SPC) + ;; Printable US-ASCII characters not including "(", ")", or "\". + (let ((good-chars (append (number-sequence #x09 #x0a) + (number-sequence #x20 #x20) + (number-sequence #x21 #x27) + (number-sequence #x2a #x5b) + (number-sequence #x5d #x7e))) + (bad-chars (append (number-sequence #x00 #x08) + (number-sequence #x0b #x1f) + (number-sequence #x28 #x29) + (number-sequence #x5c #x5c) + (number-sequence #x7f #xff)))) + (dolist (gc good-chars) + (should (eq (eudc-rfc5322-valid-comment-p (format "%c" gc)) t))) + (dolist (bc bad-chars) + (should (eq (eudc-rfc5322-valid-comment-p (format "%c" bc)) nil))))) + +;; eudc-rfc5322-make-address (address &optional firstname name comment) +(ert-deftest eudc-test-make-address () + "Tests for RFC5322 compliant email address formatting." + (should (equal (eudc-rfc5322-make-address "") + nil)) + (should (equal (eudc-rfc5322-make-address nil) + nil)) + (should (equal (eudc-rfc5322-make-address "j.sixpack@example.org") + "j.sixpack@example.org")) + (should (equal (eudc-rfc5322-make-address "<j.sixpack@example.org>") + "<j.sixpack@example.org>")) + (should (equal (eudc-rfc5322-make-address "j.sixpack@example.org" + "Joey") + "Joey <j.sixpack@example.org>")) + (should (equal (eudc-rfc5322-make-address "j.sixpack@example.org" + "Joey" + "Sixpack") + "Joey Sixpack <j.sixpack@example.org>")) + (should (equal (eudc-rfc5322-make-address "j.sixpack@example.org" + "Joey" + "Sixpack" + "ten-packs are fine, too") + "Joey Sixpack <j.sixpack@example.org> \ +(ten-packs are fine, too)")) + (should (equal (eudc-rfc5322-make-address "j.sixpack@example.org" + "" + "Sixpack, Joey") + "\"Sixpack, Joey\" <j.sixpack@example.org>")) + (should (equal (eudc-rfc5322-make-address "j.sixpack@example.org" + nil + "Sixpack, Joey") + "\"Sixpack, Joey\" <j.sixpack@example.org>")) + (should (equal (eudc-rfc5322-make-address "j.sixpack@example.org" + nil + nil + "Duh!") + "j.sixpack@example.org (Duh!)")) + (should (equal (eudc-rfc5322-make-address "j.sixpack@example.org" + nil + nil + "Duh\\!") + "j.sixpack@example.org"))) + +(require 'ert-x) ; ert-with-temp-directory + +(defvar ecomplete-database-file (ert-resource-file "ecompleterc")) + +(ert-deftest eudcb-ecomplete () + "Test the ecomplete back-end." + (ert-with-temp-directory home + (with-environment-variables (("HOME" home)) + (let ((eudc-ignore-options-file t)) + (should (equal (eudc-ecomplete-query-internal '((mail . "brigts"))) + '(((mail . "Lars Ingebrigtsen <larsi@ecomplete.org>"))))) + (should (equal (eudc-ecomplete-query-internal '((mail . "karl"))) + '(((mail . "Karl Fogel <kfogel@ecomplete.com>"))))) + (should (equal (eudc-ecomplete-query-internal '((mail . "behs"))) + '(((mail . "behse@ecomplete.org"))))) + (should (equal (eudc-ecomplete-query-internal '((mail . "louie"))) + nil)))))) + +(ert-with-temp-directory + home + (ert-deftest eudcb-mailabbrev () + "Test the mailabbrev back-end." + (with-environment-variables + (("HOME" home)) + (let ((mail-personal-alias-file (ert-resource-file "mailrc")) + (eudc-ignore-options-file t)) + (should (equal (eudc-mailabbrev-query-internal '((email . "lars"))) + '(((email . "larsi@mail-abbrev.com") + (name . "Lars Ingebrigtsen"))))) + (should (equal (eudc-mailabbrev-query-internal '((name . "lars"))) + '(((email . "larsi@mail-abbrev.com") + (name . "Lars Ingebrigtsen"))))) + (should (equal (eudc-mailabbrev-query-internal '((phone . "lars"))) + nil)) + (should (equal (eudc-mailabbrev-query-internal '((firstname . "karl"))) + '(((email . "kfogel@mail-abbrev.com") + (name . "Karl Fogel"))))) + (should (equal (eudc-mailabbrev-query-internal '((email . "louie"))) + nil)) + (should (equal (eudc-mailabbrev-query-internal '((name . "emacsheroes"))) + '(((email . "Lars Ingebrigtsen <larsi@mail-abbrev.com>, \ +Karl Fogel <kfogel@mail-abbrev.com"))))))))) + +(require 'ldap) +(ert-deftest eudcb-ldap () + "Test the LDAP back-end." + (skip-unless (and (file-exists-p "/usr/sbin/slapd") + (file-exists-p "/usr/bin/ldapsearch"))) + (cd (concat (ert-resource-directory) "..")) + (let ((ldap-process + (start-process "slapd" "*slapd*" "/usr/sbin/slapd" + "-h" "ldap://127.0.0.1:3899" "-d" "0" "-4" + "-f" (ert-resource-file "slapd.conf"))) + (ldap-host-parameters-alist '(("ldap://localhost:3899" + base "dc=gnu,dc=org" auth simple))) + (eudc-server-hotlist '(("ldap://localhost:3899" . ldap))) + (eudc-ignore-options-file t)) + (sleep-for 1) ; Wait for slapd to start. + (should (equal (with-temp-buffer + (insert "emacs-ert-test-1") + (eudc-expand-try-all) + (buffer-string)) + "Emacs ERT1 <emacs-ert-test-1@ldap.gnu.org>")) + (kill-process ldap-process))) + +(eval-and-compile + (push (expand-file-name "../elpa/packages/bbdb/lisp" source-directory) + load-path) + (defvar bbdb-file) + (require 'bbdb nil t)) + +(ert-deftest eudcb-bbdb () + "Test the BBDB back-end." + (skip-unless (featurep 'bbdb)) + (let ((bbdb-file (ert-resource-file "bbdb")) + (eudc-server-hotlist '(("" . bbdb))) + (eudc-ignore-options-file t)) + (should (equal (with-temp-buffer + (insert "emacs-ert-test-3") + (eudc-expand-try-all) + (buffer-string)) + "Emacs ERT3 <emacs-ert-test-3@bbdb.gnu.org>")))) + +(provide 'eudc-tests) ;;; eudc-tests.el ends here diff --git a/test/lisp/net/mailcap-tests.el b/test/lisp/net/mailcap-tests.el index 9e60a243b3d..04462dbc8ba 100644 --- a/test/lisp/net/mailcap-tests.el +++ b/test/lisp/net/mailcap-tests.el @@ -125,7 +125,7 @@ (ert-deftest mailcap-view-file () (with-pristine-mailcap - ;; Try using a lambda as viewer and check wether + ;; Try using a lambda as viewer and check whether ;; `mailcap-view-file' works correctly. (let* ((mailcap-mime-extensions '((".test" . "test/test")))) (mailcap-add "test/test" 'mailcap--test-viewer) diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 46fef558bf2..a5bae46a583 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -140,10 +140,11 @@ A resource file is in the resource directory as per ((eq system-type 'windows-nt) null-device) (t (add-to-list 'tramp-methods - '("mock" - (tramp-login-program "sh") + `("mock" + (tramp-login-program ,tramp-default-remote-shell) (tramp-login-args (("-i"))) - (tramp-remote-shell "/bin/sh") + (tramp-direct-async ("-c")) + (tramp-remote-shell ,tramp-default-remote-shell) (tramp-remote-shell-args ("-c")) (tramp-connection-timeout 10))) (add-to-list diff --git a/test/lisp/progmodes/python-tests.el b/test/lisp/progmodes/python-tests.el index 8330525394c..f871b7bc7d9 100644 --- a/test/lisp/progmodes/python-tests.el +++ b/test/lisp/progmodes/python-tests.el @@ -5592,6 +5592,23 @@ else: (equal (list (python-tests-look-at "else:" -1 t)) (python-info-dedenter-opening-block-positions))))) +(ert-deftest python-info-dedenter-opening-block-positions-6 () + "Test multiline block start." + (python-tests-with-temp-buffer + " +def func(): + if ( + cond1 or + cond2 + ): + something() + else +" + (python-tests-look-at "else\n") + (should + (equal (list (python-tests-look-at "if (" -1 t)) + (python-info-dedenter-opening-block-positions))))) + (ert-deftest python-info-dedenter-opening-block-message-1 () "Test dedenters inside strings are ignored." (python-tests-with-temp-buffer diff --git a/test/lisp/server-tests.el b/test/lisp/server-tests.el new file mode 100644 index 00000000000..351b8ef8d12 --- /dev/null +++ b/test/lisp/server-tests.el @@ -0,0 +1,41 @@ +;;; server-tests.el --- Emacs server test suite -*- lexical-binding:t -*- + +;; Copyright (C) 2022 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. + +;;; Code: + +(require 'ert) +(require 'server) + +;;; Tests: + +(ert-deftest server-test/server-start-sets-minor-mode () + "Ensure that calling `server-start' also sets `server-mode' properly." + (server-start) + (unwind-protect + (progn + ;; Make sure starting the server activates the minor mode. + (should (eq server-mode t)) + (should (memq 'server-mode global-minor-modes))) + ;; Always stop the server, even if the above checks fail. + (server-start t)) + ;; Make sure stopping the server deactivates the minor mode. + (should (eq server-mode nil)) + (should-not (memq 'server-mode global-minor-modes))) + +;;; server-tests.el ends here diff --git a/test/lisp/simple-tests.el b/test/lisp/simple-tests.el index 97f425f6f48..6e48f11fc02 100644 --- a/test/lisp/simple-tests.el +++ b/test/lisp/simple-tests.el @@ -73,6 +73,30 @@ (should (= (count-lines (point) (point)) 0)))) +;;; `execute-extended-command' + +(ert-deftest simple-execute-extended-command--shorter () + ;; This test can be flaky with completion frameworks other than the + ;; default, so just skip it in interactive sessions. + (skip-unless noninteractive) + (should (equal (execute-extended-command--shorter + "display-line-numbers-mode" + "display-line") + "di-n"))) + +(ert-deftest simple-execute-extended-command--describe-binding-msg () + (let ((text-quoting-style 'grave)) + (should (equal (execute-extended-command--describe-binding-msg + 'foo "m" nil) + "You can run the command `foo' with m")) + (should (equal (execute-extended-command--describe-binding-msg + 'foo [14] nil) + "You can run the command `foo' with C-n")) + (should (equal (execute-extended-command--describe-binding-msg + 'display-line-numbers-mode nil "di-n") + "You can run the command `display-line-numbers-mode' with M-x di-n")))) + + ;;; `transpose-sexps' (defmacro simple-test--transpositions (&rest body) (declare (indent 0) diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index cc9610cd393..e22d1c7be0e 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -1106,7 +1106,7 @@ final or penultimate step during initialization.")) (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-d C-x )") "\^D")) (should (equal (kbd "C-x ( C-x )") ""))) (defvar subr-test--global) diff --git a/test/lisp/thingatpt-tests.el b/test/lisp/thingatpt-tests.el index b6d0b1446a3..67dd00104b0 100644 --- a/test/lisp/thingatpt-tests.el +++ b/test/lisp/thingatpt-tests.el @@ -44,6 +44,9 @@ ;; Non alphanumeric characters can be found in URIs ("ftp://example.net/~foo!;#bar=baz&goo=bob" 3 url "ftp://example.net/~foo!;#bar=baz&goo=bob") ("bzr+ssh://user@example.net:5/a%20d,5" 34 url "bzr+ssh://user@example.net:5/a%20d,5") + ;; IPv6 brackets enclosed in [markup] + ("[http://[::1]:8000/foo]" 10 url "http://[::1]:8000/foo") + ("[http://[fe08::7:8%eth0]]" 10 url "http://[fe08::7:8%eth0]") ;; <url:...> markup ("Url: <url:foo://1.example.com>..." 8 url "foo://1.example.com") ("Url: <url:foo://2.example.com>..." 30 url "foo://2.example.com") diff --git a/test/lisp/vc/vc-tests.el b/test/lisp/vc/vc-tests.el index dc4d3af6999..13248a36509 100644 --- a/test/lisp/vc/vc-tests.el +++ b/test/lisp/vc/vc-tests.el @@ -127,7 +127,7 @@ Don't set it globally, the functions should be let-bound.") (defun vc-test--create-repo-function (backend) "Run the `vc-create-repo' backend function. -For backends which dont support it, it is emulated." +For backends which don't support it, it is emulated." (cond ((eq backend 'CVS) diff --git a/test/manual/noverlay/overlay-perf.el b/test/manual/noverlay/overlay-perf.el index e84941c08f9..4d79254a538 100644 --- a/test/manual/noverlay/overlay-perf.el +++ b/test/manual/noverlay/overlay-perf.el @@ -157,7 +157,7 @@ Return test-total elapsed time." (cond ((string-match-p "\\`-[cn]\\'" (car args)) (unless (and (cdr args) (string-match-p "\\`[0-9]+\\'" (cadr args))) - (error "%s expectes a natnum argument" (car args))) + (error "%s expects a natnum argument" (car args))) (if (equal (car args) "-c") (setq k (string-to-number (cadr args))) (setq n (string-to-number (cadr args)))) diff --git a/test/src/buffer-tests.el b/test/src/buffer-tests.el index 26a649e133c..0e6d717cbb0 100644 --- a/test/src/buffer-tests.el +++ b/test/src/buffer-tests.el @@ -42,7 +42,6 @@ recorded calls conveniently." overlay hooks-property (list (lambda (ov &rest args) - (message " %S called on %S with args %S" hooks-property ov args) (should inhibit-modification-hooks) (should (eq ov overlay)) (push (list hooks-property args) @@ -175,47 +174,41 @@ properties." (t 1 2 0)) (insert-behind-hooks (t 1 2 0))))))) - (message "BEGIN overlay-modification-hooks test-case %S" test-case) - - ;; All three hooks ignore the overlay's `front-advance' and - ;; `rear-advance' option, so test both ways while expecting the same - ;; result. - (dolist (advance '(nil t)) - (message " advance is %S" advance) - (let-alist test-case - (with-temp-buffer - ;; Set up the temporary buffer and overlay as specified by - ;; the test case. - (insert (or .buffer-text "1234")) - (let ((overlay (make-overlay - (or .overlay-beg 2) - (or .overlay-end 4) - nil - advance advance))) - (message " (buffer-string) is %S" (buffer-string)) - (message " overlay is %S" overlay) - (overlay-tests-start-recording-modification-hooks overlay) - - ;; Modify the buffer, possibly inducing calls to the - ;; overlay's modification hooks. - (should (or .insert-at .replace)) - (when .insert-at - (goto-char .insert-at) - (insert "x") - (message " inserted \"x\" at %S, buffer-string now %S" - .insert-at (buffer-string))) - (when .replace - (goto-char (point-min)) - (search-forward .replace) - (replace-match "x") - (message " replaced %S with \"x\"" .replace)) - - ;; Verify that the expected and actual modification hook - ;; calls match. - (should (equal - .expected-calls - (overlay-tests-get-recorded-modification-hooks - overlay))))))))) + (ert-info ((format "test-case: %S" test-case)) + ;; All three hooks ignore the overlay's `front-advance' and + ;; `rear-advance' option, so test both ways while expecting the same + ;; result. + (dolist (advance '(nil t)) + (ert-info ((format "advance is %S" advance)) + (let-alist test-case + (with-temp-buffer + ;; Set up the temporary buffer and overlay as specified by + ;; the test case. + (insert (or .buffer-text "1234")) + (let ((overlay (make-overlay + (or .overlay-beg 2) + (or .overlay-end 4) + nil + advance advance))) + (overlay-tests-start-recording-modification-hooks overlay) + + ;; Modify the buffer, possibly inducing calls to the + ;; overlay's modification hooks. + (should (or .insert-at .replace)) + (when .insert-at + (goto-char .insert-at) + (insert "x")) + (when .replace + (goto-char (point-min)) + (search-forward .replace) + (replace-match "x")) + + ;; Verify that the expected and actual modification hook + ;; calls match. + (should (equal + .expected-calls + (overlay-tests-get-recorded-modification-hooks + overlay))))))))))) (ert-deftest overlay-modification-hooks-message-other-buf () "Test for bug#21824. @@ -1724,7 +1717,7 @@ Test both rear-advance and non-rear-advance overlays." This test works best when Emacs is configured with --enable-checking=yes. This is a little bit like fuzz testing, -except this test has no way to reduce to a minimal failng test +except this test has no way to reduce to a minimal failing test case. Regardless, by exercising many corner cases bugs can be found using Emacs' internal consistency assertions." (let* ( @@ -8380,65 +8373,92 @@ dicta sunt, explicabo. ")) (remove-overlays) (should (= (length (overlays-in (point-min) (point-max))) 0)))) -(ert-deftest test-kill-buffer-auto-save-default () - (ert-with-temp-file file - (let (auto-save) - ;; Always answer yes. - (cl-letf (((symbol-function #'yes-or-no-p) (lambda (_) t))) - (unwind-protect - (progn - (find-file file) - (auto-save-mode t) - (insert "foo\n") - (should buffer-auto-save-file-name) - (setq auto-save buffer-auto-save-file-name) - (do-auto-save) - (should (file-exists-p auto-save)) - (kill-buffer (current-buffer)) - (should (file-exists-p auto-save))) - (when auto-save - (ignore-errors (delete-file auto-save)))))))) - -(ert-deftest test-kill-buffer-auto-save-delete () +(defun test-kill-buffer-auto-save (auto-save-answer body-func) + "Test helper for `kill-buffer-delete-auto-save' tests. + +Call BODY-FUNC with the current buffer set to a buffer visiting a +temporary file. Around the call, mock the \"Buffer modified; +kill anyway?\" and \"Delete auto-save file?\" prompts, answering +\"yes\" for the former and AUTO-SAVE-ANSWER for the latter. The +expectation should be the characters `?y' or `?n', or `nil' if no +prompt is expected. The test fails if the \"Delete auto-save +file?\" prompt does not either prompt is not issued as expected. +Finally, kill the buffer and its temporary file." (ert-with-temp-file file - (let (auto-save) - (should (file-exists-p file)) - (setq kill-buffer-delete-auto-save-files t) - ;; Always answer yes. - (cl-letf (((symbol-function #'yes-or-no-p) (lambda (_) t))) - (unwind-protect - (progn - (find-file file) - (auto-save-mode t) - (insert "foo\n") - (should buffer-auto-save-file-name) - (setq auto-save buffer-auto-save-file-name) - (do-auto-save) - (should (file-exists-p auto-save)) - ;; This should delete the auto-save file. - (kill-buffer (current-buffer)) - (should-not (file-exists-p auto-save))) - (ignore-errors (delete-file file)) - (when auto-save - (ignore-errors (delete-file auto-save))))) - ;; Answer no to deletion. - (cl-letf (((symbol-function #'yes-or-no-p) - (lambda (prompt) - (not (string-search "Delete auto-save file" prompt))))) - (unwind-protect - (progn - (find-file file) - (auto-save-mode t) - (insert "foo\n") - (should buffer-auto-save-file-name) - (setq auto-save buffer-auto-save-file-name) - (do-auto-save) - (should (file-exists-p auto-save)) - ;; This should not delete the auto-save file. - (kill-buffer (current-buffer)) - (should (file-exists-p auto-save))) - (when auto-save - (ignore-errors (delete-file auto-save)))))))) + (should (file-exists-p file)) + (save-excursion + (find-file file) + (should (equal file (buffer-file-name))) + (let ((buffer (current-buffer)) + (auto-save-prompt-happened nil)) + (cl-letf (((symbol-function #'read-multiple-choice) + (lambda (prompt choices &rest _) + (should (string-search "modified; kill anyway?" prompt)) + (let ((answer (assq ?y choices))) + (should answer) + answer))) + ((symbol-function #'yes-or-no-p) + (lambda (prompt) + (should (string-search "Delete auto-save file?" prompt)) + (setq auto-save-prompt-happened t) + (pcase-exhaustive auto-save-answer + (?y t) + (?n nil))))) + (funcall body-func) + (should (equal (null auto-save-prompt-happened) + (null auto-save-answer)))) + (when (buffer-live-p buffer) + (with-current-buffer buffer + (set-buffer-modified-p nil) + (kill-buffer))))))) + +(ert-deftest test-kill-buffer-auto-save-default () + (let ((kill-buffer-delete-auto-save-files nil)) + (test-kill-buffer-auto-save + nil + (lambda () + (let (auto-save) + (auto-save-mode t) + (insert "foo\n") + (should buffer-auto-save-file-name) + (setq auto-save buffer-auto-save-file-name) + (do-auto-save t) + (should (file-exists-p auto-save)) + (kill-buffer (current-buffer)) + (should (file-exists-p auto-save))))))) + +(ert-deftest test-kill-buffer-auto-save-delete-yes () + (let ((kill-buffer-delete-auto-save-files t)) + (test-kill-buffer-auto-save + ?y + (lambda () + (let (auto-save) + (auto-save-mode t) + (insert "foo\n") + (should buffer-auto-save-file-name) + (setq auto-save buffer-auto-save-file-name) + (do-auto-save t) + (should (file-exists-p auto-save)) + ;; This should delete the auto-save file. + (kill-buffer (current-buffer)) + (should-not (file-exists-p auto-save))))))) + +(ert-deftest test-kill-buffer-auto-save-delete-no () + (let ((kill-buffer-delete-auto-save-files t)) + (test-kill-buffer-auto-save + ?n + (lambda () + (let (auto-save) + (auto-save-mode t) + (insert "foo\n") + (should buffer-auto-save-file-name) + (setq auto-save buffer-auto-save-file-name) + (do-auto-save t) + (should (file-exists-p auto-save)) + ;; This should not delete the auto-save file. + (kill-buffer (current-buffer)) + (should (file-exists-p auto-save)) + (delete-file auto-save)))))) (ert-deftest test-buffer-modifications () (ert-with-temp-file file @@ -8448,7 +8468,7 @@ dicta sunt, explicabo. ")) (insert "foo") (should (buffer-modified-p)) (should-not (eq (buffer-modified-p) 'autosaved)) - (do-auto-save nil t) + (do-auto-save t t) (should (eq (buffer-modified-p) 'autosaved)) (with-silent-modifications (put-text-property 1 3 'face 'bold)) @@ -8472,7 +8492,7 @@ dicta sunt, explicabo. ")) (restore-buffer-modified-p nil) (should-not (buffer-modified-p)) (insert "bar") - (do-auto-save nil t) + (do-auto-save t t) (should (eq (buffer-modified-p) 'autosaved)) (insert "zot") (restore-buffer-modified-p 'autosaved) diff --git a/test/src/comp-resources/comp-test-funcs.el b/test/src/comp-resources/comp-test-funcs.el index 9092f040c80..03925d4d2e8 100644 --- a/test/src/comp-resources/comp-test-funcs.el +++ b/test/src/comp-resources/comp-test-funcs.el @@ -211,10 +211,10 @@ (comp-tests-err-arith-f) (arith-error (concat "arith-error " (error-message-string err) - " catched")) + " caught")) (error (concat "error " (error-message-string err) - " catched")))) + " caught")))) (defun comp-tests-condition-case-1-f () ;; Bpushhandler Bpophandler (condition-case @@ -222,10 +222,10 @@ (comp-tests-err-foo-f) (arith-error (concat "arith-error " (error-message-string err) - " catched")) + " caught")) (error (concat "error " (error-message-string err) - " catched")))) + " caught")))) (defun comp-tests-catch-f (f) (catch 'foo (funcall f))) diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el index 734b4a0d221..4e512098a3d 100644 --- a/test/src/comp-tests.el +++ b/test/src/comp-tests.el @@ -298,9 +298,9 @@ Check that the resulting binaries do not differ." (comp-deftest non-locals () "Test non locals." (should (string= (comp-tests-condition-case-0-f) - "arith-error Arithmetic error catched")) + "arith-error Arithmetic error caught")) (should (string= (comp-tests-condition-case-1-f) - "error Foo catched")) + "error Foo caught")) (should (= (comp-tests-catch-f (lambda () (throw 'foo 3))) 3)) diff --git a/test/src/eval-tests.el b/test/src/eval-tests.el index bb2f04e8ee1..0e12e4dbd8a 100644 --- a/test/src/eval-tests.el +++ b/test/src/eval-tests.el @@ -222,7 +222,7 @@ expressions works for identifiers starting with period." (ert-deftest eval-tests/funcall-with-delayed-message () ;; Check that `funcall-with-delayed-message' displays its message before - ;; its function terminates iff the timeout is short enough. + ;; its function terminates if the timeout is short enough. ;; This also serves as regression test for bug#55628 where a short ;; timeout was rounded up to the next whole second. diff --git a/test/src/font-tests.el b/test/src/font-tests.el index 7e9669c6513..683d331d753 100644 --- a/test/src/font-tests.el +++ b/test/src/font-tests.el @@ -115,7 +115,7 @@ expected font properties from parsing NAME.") (defun test-font-parse () "Test font name parsing." (interactive) - (switch-to-buffer (generate-new-buffer "*Font Pase Test*")) + (switch-to-buffer (generate-new-buffer "*Font Parse Test*")) (setq show-trailing-whitespace nil) (let ((pass-face '((t :foreground "green"))) (fail-face '((t :foreground "red")))) diff --git a/test/src/thread-tests.el b/test/src/thread-tests.el index 75d67140a90..731fa893c1f 100644 --- a/test/src/thread-tests.el +++ b/test/src/thread-tests.el @@ -217,7 +217,7 @@ (while (not threads-mutex-key) (thread-yield)) (thread-signal thr 'quit nil) - ;; `quit' is not catched by `should-error'. We must indicate it. + ;; `quit' is not caught by `should-error'. We must indicate it. (condition-case nil (thread-join thr) (quit (signal 'error nil))))))) |